home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue42 / opengl / glwin.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-11-26  |  153.3 KB  |  4,897 lines
  1. {============================================================}
  2. { Unit Title -  OpenGL Window                            }
  3. {                                                            }
  4. { Codemaster  -      John Hutchings                             }
  5. {   Date      -      10/6/98                                 }
  6. {  DeBugged   -               }
  7. {                                }
  8. {============================================================}
  9.  
  10. {$V+,X+,F+,B-}
  11. {$IFDEF MinSize} {$S-,L-,R-,Q-,D-} {$ENDIF}
  12.  
  13. {===============================================================================
  14. Unit to encapsulate the OpenGL  functional library into a standard
  15. DELPHI 3 VCL
  16.  
  17. PURPOSE
  18.  
  19. METHOD
  20.  
  21. COMPILER DIRECTIVES
  22.  
  23.   DEBUG     adds addition tests for valid data and type safe assigns
  24.   MINSIZE   limits debug and symbol info
  25.  
  26. GLOBALS
  27.  
  28.   Classes
  29.   Exceptions
  30.   Variables
  31.  
  32.   Procedures
  33.  
  34. EXCEPTIONS
  35.  
  36. Drawing modes
  37.  2D GL mode draw to the screen using 2D commands via the GLCanvas og GL commands directly
  38.  The viewport is set up to have the origin at the lower left of the screen with GL units representing pixels
  39.  positive up and to the right.
  40.  The X axis is to the right and the  Y axis is up.
  41.  Z is out of the screen but if used MUST be 1 or else data will be clipped
  42.  
  43.  This is used for foreground and background draws of Paper data
  44.  eg grid, borders etc.
  45.  
  46. 3D render mode
  47.  
  48. Full 3D drawing via the GLCanvas ofr directly to the GL API.  Standard GL conventions apply to the screen layout
  49. Refer to "OPENGL programming for Windows NT"
  50.  
  51. Drawing process
  52.  
  53.  The control can be invalidated via the normal routes (Invalidate,Repaint etc)
  54.  
  55.  The process of drawing is
  56.  
  57.  1.  a 2D GL Render for background Paper stuff inc grid
  58.  2.  the 3D Render of the data set
  59.  3.  a Further 2D GL Render for Foregraound stuff
  60.  
  61.  4.  the normal GDI draw using the current glcanvas caled through the "Paint".
  62.  
  63.  NOTe the normal Canvas for this window should not be used if the GDI output
  64.       is to go to the BitMap draws or printing outputs.  You should always use the GLCanvas.
  65.       The GLCanvas is a TCanvas but may be the window/bitmap/printer depending
  66.       on the current operation.
  67.  
  68.  5.  a Head Up Display (HUD) render also is called if applicable to finally draw HUD data
  69.      using the GDI and Canvas.
  70.  
  71. Each should be implemented by overriding the internal call in descendant
  72. and/or using the Event handle provided.
  73.  
  74. EVents available:
  75. OnBuildDisplay   Called when a rebuild of the Display lists is needed
  76.  can be triggered by a call to the BuildDisplayLists
  77. On2DForeGrnd     Called when the 2d foreground drawing is taking place
  78.   NOTE - the OpenGLCanvas set to 2D mode will be passed through
  79.        - the window coordinates are the same as the window but 0,0 is bottom left
  80. On3DRender
  81. On2DBackGrnd
  82. OnPaint
  83. OnHUDUpdate
  84. OnSelect
  85.  
  86. Most of the specialised events can be overriden by descendants of this
  87.  
  88. ===============================================================================}
  89.  
  90.  
  91. unit glwin;
  92.  
  93. interface
  94. uses
  95.   Windows, Messages, SysUtils, Classes, Graphics, MmSystem, ExtCtrls,
  96.   Controls, Forms, Dialogs, StdCtrls, ComCtrls, clipbrd,ActnList,
  97.   OpenGL, opengl12, glAbsWin, glFuncs, glViewFr;
  98.  
  99. Type
  100. // forward declarations
  101.   TOpenGLCanvas          = Class;
  102.   TCustomOpenGLWindow    = Class;
  103.  
  104. // specialised event procedures
  105.   TGLRenderEventNotify= procedure (Sender: TCustomOpenGLWindow;
  106.                                    GLMode: GLRenderState;
  107.                                    GL3DCanvas:TOpenGLCanvas) of object;
  108.  
  109.   TGLSelectEventNotify= procedure (Sender: TCustomOpenGLWindow;
  110.                                    XPos,YPos:LongInt;
  111.                                    WX,WY,WZ :Double;
  112.                                    var RedrawNeeded:Boolean;
  113.                                    var SelectState:GLSelectState) of object;
  114.  
  115.   tGDIUpdate = Procedure(sender:TCustomOpenGLWindow;aCanvas:TCanvas;SafeGDI:Boolean) of Object;
  116.  
  117.   tCustomViewSetUp = Procedure (Sender:TCustomOpenGLWindow) of Object;
  118.  
  119.   tAnimateNotify = Procedure (Sender:TCustomOpenGLWindow;ElapsedTime:DWord;
  120.                               Var DoRepaint:Boolean) of Object;
  121.  
  122. //Main GL window Class
  123.   TCustomOpenGLWindow = class(TAbstractOpenGL)
  124.   private
  125.     FCanvas                : TCanvas;
  126.     fGLCanvas              : tOpenGLCanvas;
  127.  
  128.     { Private declarations }
  129.     fOldMask               : Pointer;
  130.     // to handle possible Divide by zero errors
  131.  
  132.     fStartUpLoop,         // Set to true after the first loop through the WMPaint;
  133.     fLButtonDown,         // LButton currently down
  134.     fRButtonDown,         //RButton ""
  135.     fAnimationRunning,    //Animation is on/off
  136.     fViewAnimation,       //VIEWER is in motion
  137.     fClearedCurrentPos,   //no need to redraw lastpos to current pos
  138.     fSnapOn,              // cursor snap is on
  139.     fHUDon,               // display HUD text / calls DrawHUDDisplay
  140.     fFullFrameRate,       // display at the fastest frame rate
  141.     fViewportGridOn,      //display the reference grid during background draw
  142.     fViewportGridTextOn,  // display the coord text at the left and bottom
  143.     f3DCursorOn,          // show cursor as the CAD XY lines
  144.     fSimpleAxis,          // show the simple XYZ axis
  145.     fFirstMove,           // first move for a move tool
  146.     fAnimateViewPt,       // true for a loop through the future view points
  147.     fViewPtLoop           // true for continous looping
  148.  
  149.                            : Boolean;
  150.  
  151.     fViewPtIndex           : LongInt; //current index of future viewpts
  152.     fToolMode,
  153.     fLastToolMode          : GLToolMode;//current and last tool state
  154.     fMoveMode,
  155.     fLastMoveMode          : GLMoveMode;//current and last movement state
  156.     fRenderMode,
  157.     fLastRenderMode        : GLRenderState;
  158.     fViewMode              : GLViewMode;
  159.     fSelectState           : GLSelectState;
  160.  
  161.     fBackColor             : GLBackground;
  162.     fGLperPixel            : GLFloat;
  163.     //numbeer of GL units per screen pixel
  164.  
  165.     fViewClockStart,
  166.     fViewElapsedTime       : DWord;
  167.     fClockStart,
  168.     fElapsedTime           : DWord;
  169.     fShift                 : TShiftState;
  170.     fCursorPlaneRec        : tPlaneEq;
  171.  
  172.   // stores the data to manage a cursor plane
  173.   // default is parrallel to the screen at z:=0.5;
  174.     fXlStart,fXLend,
  175.     fYLStart,fYLEnd,
  176.     fZLStart,fZLEnd  :tPoint;
  177.     fxLineSet,fYLineSet,fZLineSet    : Boolean;
  178.   // Handle clearing the last 3D cursor;
  179.  
  180. // Handles for main render events
  181.     fOn2DbackgroundRender  :  TGLRenderEventNotify;
  182.  // background 2D draw event handle
  183.     f0nDrawRenderScene     :  TGLRenderEventNotify;
  184.  // 3D render event handler
  185.     fOn2DForeGroundRender  :  TGLRenderEventNotify;
  186.  // 2D foreGround event handler
  187.     fGDIPaint              :  tGDIUpdate;
  188.  // GDI Paint event handler
  189.     fOnHUDUpDate           :  tGDIUpdate;
  190.  // HUD display update event handler
  191.     fOnBuildDisplayLists   :  tGLRenderEventNotify ;
  192.  //Build of display lists when required
  193.     fOnSelectDown ,
  194.     fOnSelectMove,
  195.     fOnSelectUp           :  TGLSelectEventNotify;
  196.  //Selection of objects required
  197.     fOnCustomViewSetUp     :  tCustomViewSetUp;
  198.  // handles a custom ModelView Matrix Setup.
  199.     fOnAnimate             :  tAnimateNotify;
  200.  //Handle Model animate actions
  201.  
  202.   (*
  203.     fSelectBuffer          : Pointer;
  204.     fSelectBackSize,
  205.     fSelectBackData        : Longint;
  206. // manage the selection data
  207.    *)
  208.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  209.  
  210.     procedure GDIPaintWindow(DC: HDC);
  211.     // hanlle the GDI painting
  212.     procedure PaintWindow(DC: HDC);             Override;
  213.    // key to accessing the render stuff
  214.  
  215.     Procedure DoAnimate(Sender:tObject);
  216.     //called by the animate timer
  217.     Procedure DoViewerAnimate(Sender:tObject);
  218.     //called by the viewer timer
  219.     Procedure DrawMoveHint;
  220.     // called during the GL draw
  221.     procedure DrawMoveGuides(X,Y:LongInt);
  222.     // use the canvas to draw the temporary lines for select/pan zoom etc
  223.     procedure DrawToolGuides(X,Y:LongInt);
  224.     //draw the temporary mouse lines
  225.     Procedure DrawHUDDisplay;
  226.     //draw the HUD screen data
  227.  // calls to handle events and virtual methods
  228.     Procedure GLRender2DForeGround;
  229.   {Allow for the 2D drawing with in the buffer
  230.    Is called after the 3D render}
  231.     Procedure GLRender2DBackGround;
  232.   {Allow for the 2D drawing with in the buffer
  233.    Is called after the 3D render}
  234.     Function GetWindowPos(aVal:LongInt):LongInt;
  235.     //Use to return the Widow screen coordinate rather than the GL screen coordinate
  236.     Procedure UpDateScreenZ(X,Y:Longint;aViewer:TViewFrame);
  237.   //update the screen z from the current cursor plane found in fCursorplane
  238.     Procedure CalcCursorPlane(aP1,aP2,aP3:tGLPoint;UseCustom:Boolean);
  239.   // calc the required values for the cursor plane from P1,P2,P3);
  240.     function GetPerspective: boolean;
  241.     Function WX:GLDouble;
  242.     Function WY:GLDouble;
  243.     Function WZ:GLDouble;
  244.     Function GetGLPerPixel:GLFloat;
  245.     Function GetAnimation:Boolean;
  246.     Function GetScale:Single;
  247.     Function getXCubeSize:Double;
  248.     Function getYCubeSize:Double;
  249.     Function getZCubeSize:Double;
  250.  
  251. {    Procedure SetAngle(aAngle:Single);}
  252.     Procedure SetXCubeSize(aVal:Double);
  253.     Procedure SetYCubeSize(aVal:Double);
  254.     Procedure SetZCubeSize(aVal:Double);
  255.     Procedure SetPerspective(AState:Boolean);
  256.     Procedure SetSimpleAxis(AState:Boolean);
  257.     Procedure SetMode(aMode:GLMoveMode);       Virtual;
  258.     Procedure SetRenderMode(aRM:GLRenderState);
  259.     Procedure SetBackColor(aColor:GLBackground);
  260.     Procedure SetViewMode(aMode:GLViewMode);
  261.     Procedure SetScale(aVal:Single);
  262.     Procedure SetHUD(Val:Boolean );
  263.     Procedure SetAnimation(aVal:Boolean);
  264.     procedure SetViewportGridOn(aVal:Boolean);
  265.     procedure SetViewportGridTextOn(aVal:Boolean);
  266.     procedure SetCursor3D(aVal:Boolean);
  267.     procedure SetStdDisplayList(aVal:Boolean);
  268.  
  269.     Procedure UpdateScreenPos;
  270.     //will update all the LinkPoint screen positions
  271.     Procedure ConvertScreenToWorld(aLinkPt:TLinkPoint;UseFar:Boolean);
  272.     // Convert supplied linkPt to world    If UseFar then will use back of model
  273.     Procedure ConvertWorldToScreen(aLinkPt:TLinkPoint);
  274.  
  275.     Procedure Draw3DGDICursor(aGridType:GLGridType);
  276.     // draw the CAD style cross hairs using the GDI canvas
  277.     Procedure Draw3DCursor(aGridType:GLGridType);
  278.     // draw CAD cursor with OpenGL
  279.  
  280.     Procedure Clear3DCursor;
  281.     // clear up after the 3D cursor is drawn
  282.  
  283.     Procedure GetViewPortGrid(aGridType:GLGridType;aStep:LongInt);
  284.     // set up the grid data
  285.     Procedure DrawViewPortGrid(IncText:Boolean);
  286.     // draw the viewport grid
  287.     Procedure DrawSimpleAxis;
  288.     //draw a simple X,Y,Z axis
  289.     Procedure DrawSelectedPoints;
  290.     //Draw the selected points according to current draw mode}
  291.     {Create display list cursor}
  292.     Procedure DrawBorder;
  293.     // used to draw a border around the window, will show focus or not
  294.     Function UpdateScreenCoordsLabel:String;
  295.     // call to update a screen coord label if assigned
  296.     Function UpdateExtraScreenCoordsLabel:String;
  297.     // call to update a screen coord label if assigned
  298.     Function SelectPolyClosed:Boolean;
  299.     // test fselectlist for 'closed' poly select
  300.     Procedure SetUpStdDisplayLists;
  301.     //call to set up the standard display list (inc text)
  302.     Procedure ShutDownStdDisplayLists;
  303.     //call to shut down the standard display list (inc text
  304.     //called when the stdDsiplaylist property is changed
  305. (*
  306.     Procedure CancelSelectPoly;
  307.     //cancel the select poly and clear the fselectlist*)
  308.   protected
  309.       { Protected declarations }
  310.     fmodelMatrix           : GLMatrixArrayd;
  311.     fprojMatrix            : GLMatrixArrayd;
  312.     fviewport              : GLViewPortArray;
  313.   // Current matrices updated after each calc;
  314.     fViewerTimer  ,
  315.     fAnimateTimer          : tTimer;
  316.     fDrawToOther,         // set to true if cdrawing to a bitmap
  317.     fStdDisplayList       // true for using the std display lists
  318.  
  319.                            :Boolean;
  320.  {IDs from OpenGL Text}
  321.     fGeneralLists         : LongInt;
  322.     //Display list index for flat text
  323.     //display list index for general Display lists
  324.     fDefaultTextID,
  325.     //DisplayList index for 3D text
  326.     fDefaultFlatTextID    : LongInt;
  327.  
  328.     fOtherWidth,
  329.     fOtherHeight          : LongInt;
  330.  
  331.     fHome                 : tGLPoint;
  332.  
  333.     XDif,YDif,
  334.     XStart,YStart         : Longint;  // mouse move differences
  335.  
  336.     fViewer               : TViewFrame;              //replace all next with TViewFrame
  337.     fStartPos,
  338.     fLastPos,
  339.     fCurrentPos           : tLinkPoint;
  340.  
  341.     fSelectPoints ,
  342.     //List of selected tLinkPoints set by tools
  343.     fMovePoints           : tList;
  344.     //set of points set by move modes
  345.     fFutureViews,
  346.     // list of possible future positions
  347.     fPreviousViews        : tList;
  348.    // list of previous view records
  349.     fGridPointsList       : tList;
  350.    // list of Grid Points projected and clipped to the screen
  351.    // updated during moves etc
  352.  
  353.     fSnapPoint             : tGLPoint;
  354.     fLocationLabel,
  355.     fExtraData             : tStatusPanel;
  356.  
  357.     procedure CreateHandle;                                      Override;
  358.     procedure Paint;                                             Virtual;
  359.  
  360.     Procedure GLRenderWindow(DoSwap:Boolean);                    Virtual;
  361.    // Draw the window called by PaintWindow or the thread
  362.     function GetPalette: HPALETTE;                               override;
  363.  
  364.     Procedure GLStartUp;                                         Override;
  365.   // Startn up the GLSession
  366.     Procedure GLShutDown;                                        Override;
  367.   // Shut down a session
  368.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  369.       X, Y: Integer);                                            override;
  370.     procedure MouseMove(Shift: TShiftState; X, Y: Integer);      override;
  371.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  372.       X, Y: Integer);                                            override;
  373.  
  374.     procedure Click;                       Override;
  375.     procedure DblClick;                    Override;
  376.  
  377.     Procedure GLSessionSetUp;              Virtual;
  378.    {Set up when GL session is started}
  379.     Procedure Clearscreen;                 Virtual;
  380.     //clear all the glbuffers
  381.     Procedure UpdateScreenDisplayLists;    Virtual;
  382.  
  383.    {This procedure builds all the standard display objects for the gl
  384.    session}
  385.     Procedure BuildGrids;                  Virtual;
  386.    //set up the basic grid components
  387.     Procedure BuildBitMapText(afontname:String;aSize:smallint);
  388.    // build the basic bitmap font call if font changed using font name and size
  389.    //font must be true type
  390.     Procedure BuildOutLineFont(afontname:String);
  391.    // 3D font
  392.    //font must be true type
  393.     Procedure CloseDisplayLists;           Virtual;
  394.    //closes display lists
  395.  
  396.     Procedure SetMoveMode(aMode:GLMoveMode);       Virtual;
  397.     Procedure SetToolMode(aMode:GLToolMode);       Virtual;
  398.     Procedure SetRefPoint(val:tGLPoint);
  399.     // Set up the home point
  400.  
  401.     Procedure SetUpViewPort;               Virtual;
  402.    //Set up for the view port/s
  403.     Procedure SetUpViewingFrustrum;          Virtual;
  404.     //set for Ortho or perspective
  405.     Procedure SetUpViewingTransform;         Virtual;
  406.  
  407.     Procedure DoMoveTidyUp;                 Override;
  408.     // If pan zoom etc then tidy up the possible cursor draw
  409.  
  410.  // cals to be overridden in descendants
  411.     Procedure DoGLRender2DForeGround;            Virtual;
  412.     {Render the stock platform or fixed background}
  413.     Procedure Do3DRenderScene;                   Virtual;
  414.     {Render the scene}
  415.     Procedure DoGLRender2Dbackground;            Virtual;
  416.     {Background draw}
  417.     Procedure DoHUDUpdate;                       Virtual;
  418.  
  419.     Procedure DoOnSelectDown(X,Y:Longint;Var ReDrawNeeded:Boolean);Virtual;
  420.  // Handle the selection process
  421.     Procedure DoSelectedMove(X,Y:Longint;Var ReDrawNeeded:Boolean); Virtual;
  422.  // Used to manage the drag/stretch
  423.     Procedure DoSelectMoveFinish(X,Y:Longint;Var ReDrawNeeded:Boolean); Virtual;
  424.  // When a drag/stretch ids finished
  425.  
  426.     Procedure DoCustomViewSetUp;                 Virtual;
  427.  // handle the setup of the ModelView Matrix for vmCustomview or special setups
  428.  
  429.    (* Procedure  TextOut3D(anX,anY,anZ:glDouble;aSize:glFloat;aStr:String);*)
  430.   // use the current base font to draw string
  431.      Procedure StartViewerAnimation;                  Virtual;
  432.   // start the animation timer
  433.      Procedure StopViewerAnimation;             Virtual;
  434.   // stop the animation timer
  435.      Procedure StartAnimation;                  Virtual;
  436.   // start the animation timer
  437.      Procedure StopAnimation;                   Virtual;
  438.   // stop the animation timer
  439.      Function ProjectOnScreen(aPt:tGLPoint;
  440.                               var ScreenPt:TPoint;
  441.                               var ZDepth:GLDouble):Boolean;
  442.      Function ProjectLineOnScreen (var aPt1,aPt2 : tGLPoint):Boolean;
  443.  // project the given 3D line ont the screen returning the modified tGLPoint
  444.  // Values.  Return true if sucessful
  445.  
  446.      Function GetFromScreen(var aPt:tGLPoint;
  447.                             ScreenPt:TPoint;
  448.                             ZDepth:GLDouble):Boolean;
  449.  
  450.      Procedure GetFrontBackPoints(const XVal,YVal:Longint;ZVal,ticht:Double;
  451.                              var Point,BackPt,FrontPt,ticPt:tGLPoint);
  452.      // get the data to be able to draw line from front to back
  453.   public
  454.     { Public declarations }
  455.     constructor Create(AOwner: TComponent); Override; 
  456.     destructor Destroy;                     override;
  457.  
  458.  
  459.     procedure SetFocus;                    override;
  460.  
  461.   //gl Function wrappers
  462.     Procedure CallList(aVal:GLuint);
  463.    //handles the glCalllist after testing the value 
  464.  
  465.     Procedure ReSetView(ReSetRange:Boolean);  Virtual;
  466.     // reset the current view mode back to the start point
  467.     Procedure DoPan;                         Virtual;
  468.     //Set up the current view for a Pan
  469.     Procedure DoMove;
  470.     Procedure DoWalk;
  471.     Procedure DoFly;
  472.     Procedure DoRotate;
  473.     Procedure DoSlide;
  474.     Procedure DoMeasure(X,Y:LongInt);
  475.     Procedure DoZoom;
  476.     Procedure DoTwist;
  477.     Procedure DoScreenZ;
  478.     Procedure DoLookAt;
  479.     Procedure DoLookAtPt;
  480.     Procedure DoZoomIn;                       Virtual;
  481.     //set up the current view for a standard view in
  482.     Procedure DoZoomOut;                      Virtual;
  483.     //set up the current view to a zoom out
  484.     Procedure ZoomAll;                       Virtual;
  485.     //zoom to the current space;
  486.  
  487.     Function GetGLVendor:pchar;
  488.     Function GetGLRenderer:pchar;
  489.     Function GetGLVersion:pchar;
  490.     Function GetGLExtensions:pchar;
  491.  
  492.     Procedure BuildDisplayLists;           Virtual;
  493.     //call when screen size changes
  494.  
  495.     Procedure MoveViewByDelta(DeltaX,DeltaY,DeltaZ:GLDouble);
  496.     //will move fPosition and Lookat by delta
  497.  
  498.     { Public declarations }
  499.     {Set the XRot andYRot values}
  500.     Procedure ClearSelectList;
  501.    // clear the selected points list
  502.     Procedure ClearMoveList;
  503.     //clear the move points list
  504.     Function  IsPointOutSideSelectPoly(X,Y:LongInt):Boolean;
  505.     //return if the screen X,Y is inside the selection polygon  Return false if zero set
  506.     Function  IsPointInsideSelectPoly(X,Y:LongInt):Boolean;
  507.     //return if the screen X,Y is outside the selection polygon
  508.     Procedure GetMeasurementData(var aMeasRec:tMeasureRecord);
  509.     //Used to fill record with current move point data
  510.     Procedure SnapToPoint(aX,aY,aZ:Double;aHint:String);
  511.     // Move the cursor to this point and set the screenZ to the correct value
  512.     Procedure CopyCurrentView;
  513.     // make a copy of the curent viewing position
  514.     Procedure RestoreLastView;
  515.     // restore the last viewing position
  516.  
  517.     Procedure ShowGLHint(Var aHintStr:String; Var CanShow:Boolean; Var HintInfo:tHintInfo);
  518.     // call to handle any hint showing  stuff
  519.     // this does not belong here
  520.     Procedure getBitMapImage(aBP:tBitMap);
  521.     //return bitmap filled with current view
  522.     Function getMetaFileImage(aMF:tMetaFile;UseMFHeight:Integer;XScale,YScale:Double):Boolean;
  523.     //return the current view as a Metsfile
  524.     Procedure getFittedBitMapImage(aBP:tBitMap);
  525.     //return a specially composed bitmap filled with current view
  526.     Function getScaledMetaFileImage(PixSizeX,PixSizeY:Integer;  //Pixel size of window
  527.                                     PixResX,PixResY:Single;     //scale in Pixel/mm
  528.                                     aPrintScale:Double):tMetaFile;//scale value -1=not to scale
  529.     //draw the image to the Metafile.  Will fail if in perspective view.
  530.     Function GetSizedBitMapImage(aBP:tBitMap):Boolean;
  531.     //return a  bitmap sized to the supplied bitmap of current view
  532.     Procedure CopyToClipBoard;
  533.     //copy the current view to the clipboard as a bitmap and metafile
  534.     Procedure getBirdsEyeView(aBP:tBitMap;aSize:LongInt);
  535.     //return bitmap filled with bitmap centred on mouse pos and size
  536.  
  537.     property Canvas    :TCanvas        read fCanvas ;
  538.     // canvas for GDI Painting
  539.     property GLCanvas  :tOpenGLCanvas  read fGLCanvas;
  540.     // Canvas for OpenGL work
  541.     Property GLVendor  :pchar          Read GetGLVendor;
  542.     Property GLRenderer:pchar          Read GetGLRenderer;
  543.     Property GLVersion :pchar          Read GetGLVersion;
  544.     Property GLExtensions:pchar        Read GetGLExtensions;
  545.  
  546.     Property Coords     :tStatusPanel  Read fLocationLabel Write fLocationLabel;
  547.     Property ExtraData  :tStatusPanel  Read fExtraData Write fExtraData;
  548.     Property DisplayList:LongInt       read fGeneralLists;
  549.     Property GLPalette  :HPalette      Read fGLPalette;
  550.     Property MovePoints :TList         Read fMovePoints;
  551.     Property SelectList :TList         Read fSelectPoints;
  552.     Property Viewer     :TViewFrame    Read fViewer;
  553.     property UnitsPerPixel:GLFloat     Read GetGLPerPixel ;
  554.  
  555.     property MouseX:GLDouble Read WX;
  556.     property MouseY:GLDouble Read WY;
  557.     property MouseZ:GLDouble Read WZ;
  558.  
  559.  
  560.  {New properties}
  561.     Property Animate    :Boolean       Read GetAnimation   Write setAnimation;
  562.     Property BackGround :GLBackground  Read fBackColor     write SetBackColor;
  563.  
  564.     Property BoxSizeX   :Double       read getXCubeSize    Write SetXCubeSize;
  565.     Property BoxSizeY   :Double       read getYCubeSize    Write SetYCubeSize;
  566.     Property BoxSizeZ   :Double       read getZCubeSize    Write SetZCubeSize;
  567.     Property Cursor3D   :Boolean       Read f3DCursorOn    Write SetCursor3D;
  568.  
  569.     Property Grid       :Boolean       Read fViewportGridOn write SetViewportGridOn;
  570.     Property GridText   :Boolean       Read fViewportGridTextOn write SetViewportGridTextOn;
  571.     Property HUD        :Boolean       Read fHUDon         Write SetHUD;
  572.     Property MaxFrmRate :Boolean       Read fFullFrameRate Write fFullFrameRate;
  573.     Property MoveMode   :GLMoveMode    Read fMoveMode      write SetMode;
  574.     Property Perspective:Boolean       read GetPerspective write SetPerspective;
  575.     Property RefPoint   :tGLPoint       read fHome          Write SetRefPoint;
  576.     Property SimpleAxis :Boolean       read fSimpleAxis    write SetSimpleAxis;
  577.     Property Scale      :Single        Read GetScale       Write SetScale;
  578.     Property StdDisplayList :Boolean  Read  fStdDisplayList Write SetStdDisplayList;
  579.     Property ToolMode   :GLToolMode    Read fToolMode      write setToolMode;
  580.     Property ViewMode   :GLViewMode    Read fViewMode      Write SetViewMode;
  581.     Property RenderState:GLRenderState read fRenderMode    Write SetRenderMode;
  582.  
  583.     {GL Specific RENDERING EVENTS}
  584.  
  585.     Property OnBuildDisplayList:TGLRenderEventNotify read fOnBuildDisplayLists write fOnBuildDisplayLists;
  586.     Property On2DForeGrnd:TGLRenderEventNotify read fOn2DForeGroundRender write fOn2DForeGroundRender;
  587.     Property On3DRender  :TGLRenderEventNotify read f0nDrawRenderScene write f0nDrawRenderScene;
  588.     Property On2DBackGrnd:TGLRenderEventNotify read fOn2DbackgroundRender write fOn2DbackgroundRender;
  589.     Property OnPaint     :tGDIUpdate read fGDIPaint write fGDIPaint;
  590.     Property OnHUDUpdate :tGDIUpdate read fOnHUDUpDate write fOnHUDUpDate;
  591.     Property OnSelectDown :TGLSelectEventNotify Read fOnSelectDown Write fOnSelectDown;
  592.     Property OnSelectMove :TGLSelectEventNotify Read fOnSelectMove Write fOnSelectMove;
  593.     Property OnSelectUp   :TGLSelectEventNotify Read fOnSelectUp Write fOnSelectUp;
  594.     Property OnCustomView :tCustomViewSetUp Read fOnCustomViewSetUp Write fOnCustomViewSetUp;
  595.     Property OnAnimate   :tAnimateNotify Read fOnAnimate Write fOnAnimate;
  596.  
  597.   end;
  598.  
  599.   TOpenGLCanvas = class(Tpersistent)
  600.   private
  601.     fGLWin       : TCustomOpenGLWindow;
  602.     f3DMode      : Boolean;
  603.     fColor       : glColorVal;
  604.     fCurrentPoint: tGLPoint;
  605.     fPointSize   : glFloat;
  606.     fPointMode   : glPointMode;
  607.     fLineWidth   : GLFloat;
  608.     fStipple     : gluShort;
  609.     {fPattern     : glint;}
  610.  
  611.   Protected
  612.     Procedure SetLineWidth(aWidth:glFloat);
  613.     Procedure SetLineStyle(aStyle:gluShort);
  614.  
  615.   Public
  616.     constructor Create(AOwner: TComponent);
  617.     destructor Destroy;                     override;
  618.  
  619.     Procedure DrawPoint(aPt:tGLPoint);
  620.     Procedure MoveTo(aPt:tGLPoint);
  621.     Procedure LineTo(aPt:tGLPoint);
  622.     Procedure DrawLine(aStart,aEnd:tGLPoint);
  623.     Procedure DrawTriangle(P1,P2,P3:tGLPoint;C1,C2,C3:glColorVal);
  624.     Procedure DrawQuad(P1,P2,P3,P4:tGLPoint;C1,C2,C3,C4:glColorVal);
  625.     Procedure DrawRectangle(P1,P2:tGLPoint);
  626.     Procedure TextOut2D(loc:tGLPoint;aSize:glFloat;aStr:String);
  627.     Procedure TextOut3D(loc:tGLPoint;aSize:glFloat;aStr:String);
  628.    (* Procedur DrawPolyLine(aPtCol:tCollection);*)
  629.     Procedure DrawAxis(loc:tGLPoint;aSize:glFloat;aMode:GLRenderState);
  630.     Procedure CircleXY(loc:tGLPoint;XRadius,YRadius:glFloat);
  631.     Procedure CircleYZ(loc:tGLPoint;YRadius,ZRadius:glFloat);
  632.     Procedure CircleXZ(loc:tGLPoint;XRadius,ZRadius:glFloat);
  633.     Procedure DrawSelectHandle(aSize:Double);
  634.     // Selection handle at present position
  635.     Procedure DrawLockedSelectHandle(aSize:Double);
  636.     // draw locked selection handle
  637.  
  638.     property  Color:GLColorVal Read fColor  Write fColor;
  639.     Property  PointMode:glPointMode Read fPointMode  write fPointMode;
  640.     Property  PointSize:glFloat Read fPointSize Write fPointSize;
  641.     Property  LineWidth:GLFloat Read fLineWidth Write setLineWidth;
  642.     Property  LineStyle:gluShort read fStipple write setLineStyle;
  643.  
  644. end;
  645.  
  646. { TCustomOpenGLWindowActionLink }
  647.  
  648.   TCustomOpenGLWindowActionLink = class(TControlActionLink)
  649.   protected
  650.     FClient: TCustomOpenGLWindow;
  651.     procedure AssignClient(AClient: TObject); override;
  652.     function IsHelpContextLinked: Boolean; override;
  653.     procedure SetHelpContext(Value: THelpContext); override;
  654.   end;
  655.  
  656.   TCustomOpenGLWindowActionLinkClass = class of TCustomOpenGLWindowActionLink;
  657.  
  658. {procedure Register;}
  659.  
  660. (*************************************************************)
  661.                          implementation
  662. (*************************************************************)
  663.  
  664. constructor TCustomOpenGLWindow.Create(AOwner: TComponent);
  665. Begin
  666.   Inherited Create(aOwner);
  667.   FCanvas := TControlCanvas.Create;
  668.   TControlCanvas(FCanvas).Control := Self;
  669.  
  670.   fGrabFocus:=True;
  671.   fViewer:= TViewFrame.Create;
  672.   fAnimationRunning  := False;
  673.   fViewAnimation     :=False;
  674.   fBackColor         :=glWhiteBkgd;
  675.  
  676.   SetGLPointVal(fHome,0,0,0);
  677.  
  678.   fViewElapsedTime:=0;
  679.  
  680.   {fSelectMode:=snone;}
  681.   fToolMode     := tlNone;
  682.   fLastToolMode := tlNone;
  683.   fMoveMode     := mmNone;
  684.   fLastMoveMode := mmNone;
  685.  
  686.   fStartPos     := tLinkPoint.Create;
  687.   fLastPos      := tLinkPoint.Create;
  688.   fCurrentPos   := tLinkPoint.Create;
  689.   fSelectPoints := tList.Create;
  690.   fMovePoints   := tList.Create;
  691.   fFutureViews  := tList.Create;
  692.   fPreviousViews:= tList.Create;
  693.   fGridPointsList:= tList.create;
  694.  
  695.  
  696.   fViewMode:= vmLookDown;
  697. // set to identity for start
  698.   fmodelMatrix[1]:=1;
  699.   fmodelMatrix[6]:=1;
  700.   fmodelMatrix[11]:=1;
  701.   fmodelMatrix[16]:=1;
  702.   fprojMatrix[1]:=1;
  703.   fprojMatrix[6]:=1;
  704.   fprojMatrix[11]:=1;
  705.   fprojMatrix[16]:=1;
  706.  // setup nominal values
  707.   fviewport[1]:=0;
  708.   fviewport[2]:=0;
  709.   fviewport[3]:=600;
  710.   fviewport[4]:=800;
  711.  
  712.   fDrawToOther:=False;
  713.   With fCursorPlaneRec do
  714.    Begin
  715.      A:=0;B:=0;C:=0;D:=0;IsValid:=False;
  716.    end;
  717.   fStdDisplayList:=False;
  718. end;
  719. (******* ******************************************************)
  720. Procedure TCustomOpenGLWindow.GLStartUp;
  721.   // Startn up the GLSession
  722.   Begin
  723.     Inherited GLStartUp;
  724.      // set up local list stuff
  725.      SetUpStdDisplayLists;
  726.      // set the base for GL lists
  727.      GLSessionSetUp;
  728.  
  729.      glListBase(0);
  730.  
  731.     //dispose of the temporary value from the ancestor
  732.      fGLCanvas := TOpenGLCanvas.Create(self);
  733.  
  734.      fAnimateTimer  := tTimer.Create(Self);
  735.      fViewerTimer   := tTimer.Create(Self);
  736.      With  fAnimateTimer do
  737.        Begin
  738.          Enabled:=False;
  739.          Interval:= 5;
  740.          OnTimer:=DoAnimate;
  741.        end;
  742.  
  743.      With  fViewerTimer do
  744.        Begin
  745.          Enabled:=False;
  746.          Interval:= 5;
  747.          OnTimer:=DoViewerAnimate;
  748.        end;
  749.     // turn GL session back on after thread setup
  750.      {Set up the initial Viewing Transforms}
  751.   // check for GLErrors
  752.      GetError;
  753.      fGDIGeneric:= (GetGLVendor='Microsoft Corporation') and
  754.                    (GetGLRenderer='GDI Generic');
  755.  
  756.   end;
  757. (******* ******************************************************)
  758.  Procedure TCustomOpenGLWindow.SetUpStdDisplayLists;
  759.    Begin
  760.      If not fStdDisplayList then exit;
  761.      If not assigned(fShareGL) then
  762.       Begin
  763.         fGeneralLists:=glGenLists(glGeneralListSize);
  764.         // bitmap text stuff
  765.         fDefaultFlatTextID:=glGenLists(256);
  766.        // 3D text ARIAL font
  767.         fDefaultTextID:=glGenLists(256);
  768.       end else
  769.       Begin
  770.         If  (fShareGL is TCustomOpenGLWindow)then
  771.          Begin
  772.             fGeneralLists:=TCustomOpenGLWindow(fShareGL).fGeneralLists ;
  773.             fDefaultTextID:=TCustomOpenGLWindow(fShareGL).fDefaultTextID;
  774.             fDefaultFlatTextID:=TCustomOpenGLWindow(fShareGL).fDefaultFlatTextID;
  775.          end;
  776.       end;
  777.    end;
  778. (******* ******************************************************)
  779.  Procedure TCustomOpenGLWindow.ShutDownStdDisplayLists;
  780.    Begin
  781.      If not assigned(fShareGL) then
  782.       Begin
  783.          glDeleteLists(fGeneralLists,glGeneralListSize);
  784.          glDeleteLists(fDefaultFlatTextID,256);
  785.          glDeleteLists(fDefaultTextID,256);
  786.        end;
  787.      fGeneralLists:=0;
  788.      fDefaultTextID:=0;
  789.      fDefaultFlatTextID:=0;
  790.    end;
  791. (******* ******************************************************)
  792.  Procedure TCustomOpenGLWindow.CallList(aVal:GLuint);
  793.    Begin
  794.      If  not fStdDisplayList then exit;
  795.      If glIsList(aVal) then
  796.         glcallList(aVal);
  797.    end;
  798. (******* ******************************************************)
  799. Procedure TCustomOpenGLWindow.GLShutDown;
  800.   // Shut down a session
  801.   Begin
  802.     ShutDownStdDisplayLists;
  803.     Inherited GLShutDown;
  804.   end;
  805. (******* ******************************************************)
  806. destructor TCustomOpenGLWindow.Destroy;
  807.  Var i:LongInt;
  808. Begin
  809.  {Ensure all GL stuff is freed}
  810.   fGLCanvas.Free;
  811.   If assigned(fCanvas) then fCanvas.Free;
  812.   {If Assigned(fAnimateThread) then fAnimateThread.Free;}
  813.   If Assigned(fAnimateTimer) then fAnimateTimer.Free;
  814.   If Assigned(fViewerTimer) then fViewerTimer.Free;
  815.  
  816.   fStartPos.Free;
  817.   fLastPos.Free;
  818.   fCurrentPos.Free;
  819.  
  820.   For i:=0 to fSelectPoints.count-1 do
  821.       tLinkPoint(fSelectPoints.Items[i]).Free;
  822.   fSelectPoints.Clear;
  823.   fSelectPoints.Free;
  824.  
  825.   For i:=0 to fMovePoints.count-1 do
  826.       tLinkPoint(fMovePoints.Items[i]).Free;
  827.   fMovePoints.Clear;
  828.   fMovePoints.Free;
  829.  
  830.   For i:=0 to fGridPointsList.count-1 do
  831.       FreeMem(fGridPointsList.Items[i],SizeOf(tGLPoint));
  832.   fGridPointsList.Clear;
  833.   fGridPointsList.Free;
  834.  
  835.   fViewer.Free;
  836.  
  837. // tidy up the animate view positions
  838.   For i:=0 to fFutureViews.Count-1 do
  839.    TViewFrame(fFutureViews.Items[i]).Free;
  840.   fFutureViews.Clear;
  841.   fFutureViews.Free;
  842.  
  843. // tidy up previous views
  844.   For i:=0 to fPreviousViews.Count-1 do
  845.    TViewFrame(fPreviousViews.Items[i]).Free;
  846.   fPreviousViews.Clear;
  847.   fPreviousViews.Free;
  848.   Inherited Destroy;
  849. end;
  850. (*************************************************************)
  851. procedure TCustomOpenGLWindow.WMSize(var Message: TWMSize);
  852.  Var I:LongInt;
  853. Begin
  854.    Inherited;
  855.    //valid OpenGL session
  856.    if fHRC<>0 then
  857.     Begin
  858.      glLock;
  859.      UpdateScreenDisplayLists;
  860.  
  861.      SetUpViewPort;
  862.      SetUpViewingFrustrum;
  863.  
  864.      DoMoveTidyUp;
  865.     // set the height field for all the link points
  866.      fStartPos.SetHeight(height);
  867.      fLastPos.SetHeight(height);
  868.      fCurrentPos.SetHeight(height);
  869.  
  870.      For i:=0 to fSelectPoints.Count-1 do
  871.          tLinkPoint(fSelectPoints.Items[I]).SetHeight(height);
  872.      For i:=0 to fMovePoints.Count-1 do
  873.          tLinkPoint(fMovePoints.Items[I]).SetHeight(height);
  874.      UpdateScreenPos;
  875.      glUnlock;
  876.     end;
  877.    Repaint;
  878. end;
  879. (*************************************************************)
  880. Procedure TCustomOpenGLWindow.CreateHandle;
  881.   Begin
  882.    Inherited;
  883.   end;
  884. (*************************************************************)
  885. procedure TCustomOpenGLWindow.SetFocus;
  886. begin
  887.      fFirstMove:=True;
  888.      fClearedCurrentPos:=True;
  889.      UpdateScreenPos;
  890.      Inherited;
  891. end;
  892. (*************************************************************)
  893. Procedure TCustomOpenGLWindow.SetUpViewPort;
  894.     {Set up for the view port/s}
  895.   Begin
  896.      if fHRC=0 then exit;
  897.      EnableGL;
  898.   //allow for a border around the window
  899.      If not fDrawToOther then
  900.       glViewport(0,0,width,height) else
  901.       glViewport(0,0,fOtherWidth,fOtherHeight);
  902.      glGetIntegerv(GL_VIEWPORT,pGLInt(@fViewPort));
  903.     // viewport matrix
  904.   // check for GLErrors
  905.      GetError;
  906.   end;
  907. (*************************************************************)
  908. Procedure TCustomOpenGLWindow.SetUpViewingFrustrum;
  909. Var h,w:GLint;
  910.     aspect:GLDouble;
  911.     Dist:Double;
  912. Begin
  913.   if fHRC=0 then exit;
  914.   EnableGL;
  915.   glMatrixMode(GL_PROJECTION);
  916.   glLoadIdentity;
  917.   If not fDrawToOther then
  918.    Begin
  919.      If Height=0 then h:=1 else h:=height-2*fBorderWidth;
  920.      If Width=0  then w:=1 else w:=width- 2*fBorderWidth;
  921.    end else
  922.    Begin
  923.      If fOtherHeight=0 then h:=1 else h:=fOtherHeight;
  924.      If fOtherWidth=0  then w:=1 else w:=fOtherWidth;
  925.    end;
  926.  
  927.   with fViewer do
  928.    begin
  929.     Dist:=Distance*20;
  930.     aspect:=w/h;
  931.     If Perspective then
  932.       Begin
  933.         gluperspective(ViewAngle,aspect,10,dist);
  934.         If w>h then  fGLperPixel:= Range/h else fGLperPixel:=Range/Width;
  935.       end else
  936. //manage the perspective case or the Ortho case
  937.        If w>h then
  938.         Begin
  939.            glOrtho(-Range*aspect,Range*aspect,-Range,Range,10,Dist);
  940.            fGLperPixel:= Range/h;
  941.        end else
  942.        Begin
  943.            glOrtho(-Range,Range,-Range/aspect,Range/aspect,10,Dist);
  944.            fGLperPixel:=Range/width;
  945.        end;
  946.     glGetDoublev(GL_PROJECTION_MATRIX,pGLDouble(@fprojMatrix));
  947.     // projection matrix
  948.     glMatrixMode(GL_MODELVIEW);
  949.    end;
  950.   // check for GLErrors
  951.    GetError;
  952. end;
  953. (*************************************************************)
  954. Procedure TCustomOpenGLWindow.SetUpViewingTransform;
  955. Begin
  956.   if fHRC=0 then exit;
  957.   EnableGL;
  958.  
  959.   glMatrixMode(GL_MODELVIEW);
  960.   glLoadIdentity;
  961.  
  962.   If fViewMode<>vmCustom then
  963.    with fViewer do
  964.     gluLookAt(Position.X, Position.Y, Position.Z,
  965.               LookAt.X, LookAt.Y, LookAt.Z,
  966.               UpVector.X, UpVector.Y, UpVector.Z)
  967.  
  968.    else
  969.     DoCustomViewSetUp;
  970.  
  971.   If fViewer.Scale<>1 then
  972.    // Handle scaling 3.281=feet
  973.      with fViewer do
  974.        glScalef(Scale,Scale,Scale);
  975.  
  976. // Calc the ModelView Matrix
  977.   glGetDoublev(GL_MODELVIEW_MATRIX,pGLDouble(@fModelMatrix));
  978.  // get the matrix
  979.   UpdateScreenPos;
  980. // update all screen positions after a screen setup
  981.   fValidBuffer:=False;
  982.  // check for GLErrors
  983.   GetError;
  984.  
  985. end;
  986. (*************************************************************)
  987. Procedure TCustomOpenGLWindow.ReSetView(ReSetRange:Boolean);
  988.     // reset the current view mode back to the start point
  989. Var aScrnPt:TPoint;
  990.     TempDist,tempZ:Double;
  991.     P1,P2,P3:tGLPoint;
  992. Begin
  993.   if fHRC=0 then exit;
  994.   with fViewer do
  995.    begin
  996.     LookAt:= fHome;
  997.     UpVector:= z_vector;
  998.  
  999.     Case fViewMode of
  1000.       vmLookDown:Begin
  1001.         TempDist:=2*ZRadius;
  1002.         SetViewer3d(fHome.X,fHome.Y,fHome.Z+TempDist);
  1003.         UpVector:= y_vector;
  1004.         end;
  1005.       vmLookUp:Begin
  1006.         TempDist:=2*ZRadius;
  1007.         SetViewer3d(fHome.X,fHome.Y,fHome.Z-TempDist);
  1008.         UpVector:= y_vector;
  1009.         end;
  1010.       vmLookWest: Begin
  1011.         TempDist:=2*XRadius;
  1012.         SetViewer3d(fHome.X-TempDist,fHome.Y,fHome.Z);
  1013.         end;
  1014.       vmLookEast:Begin
  1015.         TempDist:=2*XRadius;
  1016.         SetViewer3d(fHome.X+TempDist,fHome.Y,fHome.Z);
  1017.         end;
  1018.       vwLookNorth: Begin
  1019.         TempDist:=2*YRadius;
  1020.         SetViewer3d(fHome.X,fHome.Y-TempDist,fHome.Z);
  1021.         end;
  1022.       vmLookSouth:Begin
  1023.         TempDist:=2*YRadius;
  1024.         SetViewer3d(fHome.X,fHome.Y+TempDist,fHome.Z);
  1025.         end;
  1026.       vmCustom:Begin
  1027.         TempDist:=2*YRadius;
  1028.         SetViewer3d(fHome.X,fHome.Y-TempDist,fHome.Z);
  1029.         end;
  1030.       else begin
  1031.         TempDist:=2*ZRadius;
  1032.         SetViewer3d(fHome.X,fHome.Y,fHome.Z-TempDist);
  1033.        end;
  1034.     end; {case}
  1035.     if ReSetRange then
  1036.      begin
  1037.       Case fViewMode of
  1038.         vmLookDown,vmLookUp    :If XRadius>YRadius then TempDist:=Yradius else TempDist:=Xradius;
  1039.         vmLookWest,vmLookEast  :If YRadius>ZRadius then TempDist:=Zradius else TempDist:=Yradius;
  1040.         vwLookNorth,vmLookSouth:If XRadius>ZRadius then TempDist:=Zradius else TempDist:=Xradius;
  1041.         vmCustom: TempDist:=DefaultSize;
  1042.         else TempDist:=DefaultSize;
  1043.       end;
  1044.     end;
  1045.    setRange(TempDist,True);
  1046.   end; //end with viewer
  1047.  
  1048.   SetUpViewPort;
  1049.   SetUpViewingFrustrum;
  1050.   SetUpViewingTransform;
  1051.  
  1052.   fValidBuffer:=False;
  1053.  
  1054.  //Set screenZ value by projecting fHome onto the screen
  1055.   If not ProjectOnScreen(fHome,aScrnPt,TempZ) then
  1056.     TempZ:=0.5;
  1057.   viewer.screenZ:=TempZ;
  1058.   CalcCursorPlane(P1,P2,P3,False);
  1059. end;
  1060. (*************************************************************)
  1061. procedure TCustomOpenGLWindow.GDIPaintWindow(DC: HDC);
  1062. begin
  1063.   FCanvas.Lock;
  1064.   try
  1065.     FCanvas.Handle := DC;
  1066.     try
  1067.       TControlCanvas(FCanvas).UpdateTextFlags;
  1068.       Paint;
  1069.       If fGDIGeneric then DrawHUDDisplay;
  1070.    // draw the HUD display if required
  1071.    //Allow for the GUI paint after swap buffers
  1072.       DrawMoveHint;
  1073.    // draw the on screen data
  1074.    // MUST use only canvas draw;
  1075.      finally
  1076.       FCanvas.Handle := 0;
  1077.     end;
  1078.   finally
  1079.     FCanvas.Unlock;
  1080.   end;
  1081. end;
  1082. (*************************************************************)
  1083.  Procedure TCustomOpenGLWindow.DoMoveTidyUp;
  1084.     // If pan zoom etc then tidy up the possible cursor draw
  1085.   Begin
  1086.       fClearedCurrentPos:=True;
  1087.   end;
  1088. (*************************************************************)
  1089.  Procedure TCustomOpenGLWindow.DoPan;
  1090.     //Set up the current view for a Pan
  1091.     var DX,DY,DZ:Double;
  1092.     Begin
  1093.       DoMoveTidyUp;
  1094.       DX:=fStartPos.X-flastPos.X;
  1095.       DY:=fStartPos.Y-flastPos.Y;
  1096.       DZ:=fStartPos.Z-flastPos.Z;
  1097.       if (abs(Dx)<MoveTolerance) and
  1098.          (abs(Dy)<MoveTolerance) and
  1099.          (abs(DZ)<MoveTolerance) then exit;
  1100.       MoveViewByDelta(DX,DY,DZ);
  1101.     end;
  1102. (*************************************************************)
  1103.  Procedure TCustomOpenGLWindow.DoMove;
  1104.    Begin
  1105.       DoMoveTidyUp;
  1106.       fViewer.SetViewer3d(flastPos.X,flastPos.Y,flastPos.Z);
  1107.       Repaint;
  1108.    end;
  1109. (*************************************************************)
  1110.  Procedure TCustomOpenGLWindow.DoLookAtPt;
  1111.    Begin
  1112.       DoMoveTidyUp;
  1113.       fViewer.SetLookAt3d(flastPos.X,flastPos.Y,flastPos.Z);
  1114.       Repaint;
  1115.    end;
  1116. (*************************************************************)
  1117. Procedure TCustomOpenGLWindow.DoWalk;
  1118. Begin
  1119.   DoMoveTidyUp;
  1120.   fViewer.AdvanceToLookAt(-2*YDif/RotSensitivity);
  1121.   fViewer.RotateAboutViewer(XDif/(RotSensitivity*2),0);
  1122.   Repaint;
  1123. end;
  1124. (*************************************************************)
  1125. Procedure TCustomOpenGLWindow.DoFly;
  1126. Begin
  1127.   DoMoveTidyUp;
  1128.   If (ssShift in fShift) then
  1129.   fViewer.FlyBy(-fly_speed,XDif/RotSensitivity,YDif/RotSensitivity)
  1130.    else
  1131.   fViewer.FlyBy(fly_speed,XDif/RotSensitivity,YDif/RotSensitivity);
  1132.   Repaint;
  1133. end;
  1134. (*************************************************************)
  1135. Procedure TCustomOpenGLWindow.DoRotate ;
  1136. Begin
  1137.   DoMoveTidyUp;
  1138.   fViewer.RotateAboutLookAt(XDif/RotSensitivity,YDif/RotSensitivity);
  1139.   Repaint;
  1140. end;
  1141. (*************************************************************)
  1142. Procedure TCustomOpenGLWindow.DoSlide;
  1143.  var
  1144.  Dx,Dy,DZ:GLDouble;
  1145.  
  1146.  Begin
  1147.   DoMoveTidyUp;
  1148.  
  1149.   fStartPos.SetWinScreenPt(XStart,YStart,height,fViewer.ScreenZ);
  1150.   ConvertScreenToWorld(fStartPos,False);
  1151.  
  1152.   Dx:=fCurrentPos.X-fStartPos.X;
  1153.   DY:=fCurrentPos.Y-fStartPos.Y;
  1154.   DZ:=fCurrentPos.Z-fStartPos.Z;
  1155.   MoveViewByDelta(-DX/20,-DY/20,-DZ/20);
  1156.  end;
  1157. (*************************************************************)
  1158. Procedure TCustomOpenGLWindow.DoMeasure(X,Y:LongInt);
  1159. Begin
  1160.   DoMoveTidyUp;
  1161.   fMovePoints.Add(fCurrentPos.Duplicate);
  1162. end;
  1163. (*************************************************************)
  1164. procedure TCustomOpenGLWindow.DoZoom;
  1165.  var
  1166.  Cx,Cy,Cz:GLDouble;
  1167.  Dx,Dy,DZ:GLDouble;
  1168.  SCX,SCY:LongInt;
  1169.  NewRange:Double;
  1170.  P1,P2,P3:tGLPoint;
  1171.  
  1172.     Function getMidPoint(D1,D2:Double):Double;
  1173.       Begin
  1174.        If D1=D2 then
  1175.         Begin
  1176.           Result:=D1;
  1177.           exit;
  1178.         end;
  1179.        If D1>D2 then
  1180.          Result:=((D1-D2)/2)+D2
  1181.         else
  1182.          Result:=((D2-D1)/2)+D1;
  1183.       end;
  1184.  Begin
  1185.   {CopyCurrentView;}
  1186.   If fViewer.perspective then UpdateScreenPos;
  1187.   DoMoveTidyUp;
  1188.  
  1189.   Cx:=GetMidPoint(fCurrentPos.X,fStartPos.X);
  1190.   Cy:=GetMidPoint(fCurrentPos.y,fStartPos.y);
  1191.   Cz:=GetMidPoint(fCurrentPos.z,fStartPos.z);
  1192.  
  1193.   Dx:=Cx-fViewer.LookAt.X;
  1194.   Dy:=Cy-fViewer.LookAt.y;
  1195.   Dz:=Cz-fViewer.LookAt.z;
  1196.   fViewer.SetLookAt3d(cx,cy,cz);
  1197.  
  1198.   cx:=fViewer.position.x+DX;
  1199.   cy:=fViewer.position.y+Dy;
  1200.   cz:=fViewer.position.z+Dz;
  1201.   fViewer.setviewer3d(cx,cy,cz);
  1202.  
  1203.   If not fViewer.Perspective then
  1204.    Begin
  1205.       SCX:=abs(fCurrentPos.SX-fStartPos.SX);
  1206.       SCy:=abs(fCurrentPos.Sy-fStartPos.Sy);
  1207.       If SCX>=SCY then
  1208.         NewRange:=SCX*fGLperPixel else
  1209.         NewRange:=SCY*fGLperPixel;
  1210.       fViewer.SetRange(NewRange,True);
  1211.    end;
  1212.   SetUpViewingFrustrum;
  1213.   CalcCursorPlane(P1,P2,P3,False);
  1214.  
  1215.   UpdateScreenPos;
  1216.  
  1217. end;
  1218. (*************************************************************)
  1219.  Procedure TCustomOpenGLWindow.DoTwist;
  1220.  Begin
  1221.   DoMoveTidyUp;
  1222.   fViewer.RotateUpVector(XDif/RotSensitivity);
  1223.   Repaint;
  1224.  end;
  1225. (*************************************************************)
  1226.  Procedure TCustomOpenGLWindow.DoScreenZ;
  1227.  Begin
  1228.   DoMoveTidyUp;
  1229.   Repaint;
  1230.  end;
  1231. (*************************************************************)
  1232. Procedure TCustomOpenGLWindow.DoLookAt;
  1233. Begin
  1234.   CopyCurrentView;
  1235.   DoMoveTidyUp;
  1236.   fViewer.RotateAboutViewer(-XDif/RotSensitivity,-YDif/RotSensitivity);
  1237.   Repaint;
  1238. end;
  1239. (*************************************************************)
  1240. Procedure TCustomOpenGLWindow.DoZoomIn;
  1241.     //set up the current view for a standard view in
  1242. Begin
  1243.   CopyCurrentView;
  1244.   DoMoveTidyUp;
  1245.   fViewer.SetRange(fViewer.Range*0.8,True);
  1246.   SetUpViewingFrustrum;
  1247.   UpDateScreenPos;
  1248.   Repaint;
  1249. end;
  1250. (*************************************************************)
  1251.  Procedure TCustomOpenGLWindow.DoZoomOut;
  1252. //set up the current view to a zoom out
  1253. Begin
  1254.   CopyCurrentView;
  1255.   DoMoveTidyUp;
  1256.   fViewer.SetRange(fViewer.Range/0.8,True);
  1257.   SetUpViewingFrustrum;
  1258.   UpDateScreenPos;
  1259.   Repaint;
  1260. end;
  1261. (*************************************************************)
  1262. Procedure TCustomOpenGLWindow.ZoomAll;
  1263.     //zoom to the current space;
  1264. Begin
  1265.   CopyCurrentView;
  1266.   DoMoveTidyUp;
  1267.   ReSetView(True);
  1268.   Repaint;
  1269. end;
  1270. (*************************************************************)
  1271. Procedure TCustomOpenGLWindow.MoveViewByDelta(DeltaX,DeltaY,DeltaZ:GLDouble);
  1272.     //will move fPosition and Lookat by delta
  1273. Begin
  1274.   DoMoveTidyUp;
  1275.   fViewer.MoveFrame(DeltaX,DeltaY,DeltaZ);
  1276.   SetUpViewingTransform;
  1277.   Repaint;
  1278. end;
  1279. (*************************************************************)
  1280. procedure TCustomOpenGLWindow.Paint;
  1281. {GUI paint which will be called after the Render  function}
  1282. Begin
  1283.    If Assigned(fGDIPaint) then fGDIPaint(Self,fCanvas,fGDIGeneric);
  1284. end;
  1285. (*************************************************************)
  1286. Function TCustomOpenGLWindow.GetWindowPos(aVal:LongInt):LongInt;
  1287. //Use to return the Widow screen coordinate rather than the GL screen coordinate
  1288. Begin
  1289.   Result:=height-aVal ;
  1290. end;
  1291. (*************************************************************)
  1292. procedure TCustomOpenGLWindow.DrawMoveGuides(X,Y:LongInt);
  1293. Var
  1294.   OldMode:TPenMode;
  1295.   oldStyle:TPenStyle;
  1296.   oldColor:TColor;
  1297.   oldBStyle:tBrushStyle;
  1298.   X1,X2,Y1,Y2:LongInt;
  1299. Begin
  1300.   iF fmovemode=mmnone then
  1301.    Begin
  1302.     exit;
  1303.    end;
  1304.   If fGDIGeneric then
  1305.    Begin
  1306.         With fCanvas do
  1307.         begin
  1308.           OldMode:= Pen.Mode;
  1309.           Pen.Mode:=pmXOr ;
  1310.           OldColor:=Pen.Color;
  1311.           Pen.Color:=clWhite;
  1312.           OldStyle:=Pen.Style;
  1313.           Pen.Style:=psdot;
  1314.           oldBStyle:=Brush.Style;
  1315.           Brush.Style:=bsClear;
  1316.           Case fMoveMode of
  1317.             mmNone:;
  1318.            {  sPoint:;}
  1319.             mmZoom: If fLButtonDown then
  1320.               begin
  1321.                 //tidy up
  1322.                 If abs(fStartPos.SPt.X)>abs(fCurrentPos.SPt.X) then
  1323.                 Begin
  1324.                   X1:=(fCurrentPos.SPt.X); X2:=(fStartPos.SPt.X);
  1325.                 end else
  1326.                 Begin
  1327.                   X2:=(fCurrentPos.SPt.X);X1:=(fStartPos.SPt.X);
  1328.                 end;
  1329.  
  1330.                 If fCurrentPos.SPt.Y>fStartPos.SPt.Y then
  1331.                 Begin
  1332.                   Y1:=fCurrentPos.SPt.Y; Y2:=fStartPos.SPt.Y;
  1333.                 end  else
  1334.                 Begin
  1335.                   Y2:=fCurrentPos.SPt.Y; Y1:=fStartPos.SPt.Y;
  1336.                 end;
  1337.                 Rectangle(X1,Y1,X2,Y2);
  1338.                 If X<(fStartPos.SPt.X) then
  1339.                 Begin
  1340.                   X1:=X; X2:=(fStartPos.SPt.X);
  1341.                 end else
  1342.                 Begin
  1343.                   X2:=X; X1:=(fStartPos.SPt.X);
  1344.                 end;
  1345.                 If Y<fStartPos.SPt.Y then
  1346.                 Begin
  1347.                   Y1:=Y; Y2:=fStartPos.SPt.Y;
  1348.                 end  else
  1349.                 Begin
  1350.                   Y2:=Y; Y1:=fStartPos.SPt.Y;
  1351.                 end;
  1352.                 Rectangle(X1,Y1,X2,Y2);
  1353.               end;
  1354.             mmPan:  If fLButtonDown then
  1355.               begin
  1356.                 MoveTo(fStartPos.SPt.X,fStartPos.SPt.Y);
  1357.                 LineTo(fCurrentPos.SPt.X,fCurrentPos.SPt.Y);
  1358.                 MoveTo(fStartPos.SPt.X,fStartPos.SPt.Y);
  1359.                 LineTo(X,Y);
  1360.               end;
  1361.             mmMeasure:
  1362.                 If (fMovePoints.Count>0) then
  1363.                 Begin
  1364.                   If not fFirstMove then
  1365.                    Begin
  1366.                     MoveTo(fStartPos.SPt.X,fStartPos.SPt.Y);
  1367.                     LineTo(fCurrentPos.SPt.X,fCurrentPos.SPt.Y);
  1368.                    end;
  1369.                   MoveTo(fStartPos.SPt.X,fStartPos.SPt.Y);
  1370.                   LineTo(X,Y);
  1371.                   If not fFirstMove then
  1372.                    Begin
  1373.                     MoveTo(fCurrentPos.SPt.x,fCurrentPos.SPt.Y);
  1374.                     LineTo(tLinkPoint(fMovePoints.Items[0]).SPt.X,
  1375.                            tLinkPoint(fMovePoints.Items[0]).SPt.Y);
  1376.                    end else
  1377.                      fFirstMove:=False;
  1378.                   MoveTo(X,Y);
  1379.                   LineTo(tLinkPoint(fMovePoints.Items[0]).SPt.X,
  1380.                          tLinkPoint(fMovePoints.Items[0]).SPt.Y);
  1381.                 end;
  1382.           end;{Case}
  1383.           Pen.Mode:=OldMode;
  1384.           Pen.Style:=oldStyle;
  1385.           Brush.Style:=oldBStyle;
  1386.           Pen.Color:=OldColor;
  1387.         end;
  1388.     end else
  1389.     Begin
  1390.  
  1391.     end;
  1392. end;
  1393. (*************************************************************)
  1394. procedure TCustomOpenGLWindow.DrawToolGuides(X,Y:LongInt);
  1395.     //draw the temporary mouse lines
  1396. Var
  1397.   OldMode:TPenMode;
  1398.   oldStyle:TPenStyle;
  1399.   oldColor:TColor;
  1400.   oldBStyle:tBrushStyle;
  1401.   X1,X2,Y1,Y2:LongInt;
  1402.  
  1403.   Procedure DrawSegs;
  1404.     var i:longInt;
  1405.         SPos,EPos:tLinkPoint;
  1406.     Begin
  1407.      For i:=0 to fSelectPoints.Count-2 do
  1408.      Begin
  1409.       SPos:=tLinkPoint(fSelectPoints.Items[i]);
  1410.       EPos:=tLinkPoint(fSelectPoints.Items[i+1]);
  1411.       fCanvas.MoveTo(SPos.SPt.X,sPos.SPT.Y);
  1412.       fCanvas.LineTo(EPos.SPt.X,EPos.SPt.Y);
  1413.      end;
  1414.     end;
  1415.  
  1416.   Procedure DrawThePloy;
  1417.     Begin
  1418.       If (fSelectState=stPoly) and (fSelectPoints.Count>0) then
  1419.         Begin
  1420.          With fCanvas do
  1421.          begin
  1422.           OldStyle:=Pen.Style;
  1423.           Pen.Style:=psdot;
  1424.  
  1425.           DrawSegs;
  1426.  
  1427.           OldMode:= Pen.Mode;
  1428.           Pen.Mode:=pmXOr ;
  1429.           OldColor:=Pen.Color;
  1430.           Pen.Color:=clWhite;
  1431.           oldBStyle:=Brush.Style;
  1432.           Brush.Style:=bsClear;
  1433.  
  1434.            If not fClearedCurrentPos then
  1435.               Begin
  1436.                     MoveTo(fStartPos.SPt.X,fStartPos.sPt.Y);
  1437.                     LineTo(fCurrentPos.SPt.X,fCurrentPos.sPt.Y);
  1438.               end else
  1439.                     fClearedCurrentPos:=False;
  1440.           MoveTo(fStartPos.SX,fStartPos.SPt.Y);
  1441.           LineTo(X,Y);
  1442.  
  1443.           Pen.Mode:=OldMode;
  1444.           Pen.Style:=oldStyle;
  1445.           Brush.Style:=oldBStyle;
  1446.           Pen.Color:=OldColor;
  1447.        end;
  1448.       end;
  1449.     end;
  1450. Begin
  1451.   If (fToolMode=tlNone) or fViewAnimation then exit;
  1452.   If fGDIGeneric then
  1453.    Begin
  1454.          With fCanvas do
  1455.          begin
  1456.           OldMode:= Pen.Mode;
  1457.           Pen.Mode:=pmXOr ;
  1458.           OldColor:=Pen.Color;
  1459.           Pen.Color:=clWhite;
  1460.           OldStyle:=Pen.Style;
  1461.           Pen.Style:=psdot;
  1462.           oldBStyle:=Brush.Style;
  1463.           Brush.Style:=bsClear;
  1464.           Case fToolMode of
  1465.             tlPoint:;
  1466.             tlLine:
  1467.               begin
  1468.                 If odd(fSelectPoints.Count) then
  1469.                 Begin
  1470.                   If not fClearedCurrentPos then
  1471.                   Begin
  1472.                     MoveTo(fStartPos.SX,GetWindowPos(fStartPos.SY));
  1473.                     LineTo(fCurrentPos.SX,GetWindowPos(fCurrentPos.SY));
  1474.                   end else
  1475.                    fClearedCurrentPos:=False;
  1476.                   MoveTo(fStartPos.SX,GetWindowPos(fStartPos.SY));
  1477.                   LineTo(X,Y);
  1478.                 end;
  1479.               end;
  1480.             tlPolyLine:
  1481.               Begin
  1482.                 If not fClearedCurrentPos then
  1483.                 Begin
  1484.                   MoveTo(fStartPos.SX,GetWindowPos(fStartPos.SY));
  1485.                   LineTo(fCurrentPos.SX,GetWindowPos(fCurrentPos.SY));
  1486.                 end else
  1487.                  fClearedCurrentPos:=False;
  1488.                 MoveTo(fStartPos.SX,GetWindowPos(fStartPos.SY));
  1489.                 LineTo(X,Y);
  1490.               end;
  1491.             tlPolyGon:
  1492.               Begin
  1493.                 If not fClearedCurrentPos then
  1494.                 Begin
  1495.                   MoveTo(fStartPos.SX,GetWindowPos(fStartPos.SY));
  1496.                   LineTo(fCurrentPos.SX,GetWindowPos(fCurrentPos.SY));
  1497.                 end
  1498.                 else
  1499.                   fClearedCurrentPos:=False;
  1500.                 MoveTo(fStartPos.SX,GetWindowPos(fStartPos.SY));
  1501.                 LineTo(X,Y);
  1502.                 If fSelectPoints.Count>0 then
  1503.                  Begin
  1504.                   MoveTo(fCurrentPos.SX,GetWindowPos(fCurrentPos.SY));
  1505.                   LineTo(tLinkPoint(fSelectPoints.Items[0]).SX,
  1506.                          GetWindowPos(tLinkPoint(fSelectPoints.Items[0]).SY));
  1507.                   MoveTo(X,Y);
  1508.                   LineTo(tLinkPoint(fSelectPoints.Items[0]).SX,
  1509.                          GetWindowPos(tLinkPoint(fSelectPoints.Items[0]).SY));
  1510.                  end;
  1511.               end;
  1512.             tlRectangle:
  1513.               begin
  1514.                 If odd(fSelectPoints.Count) then Begin
  1515.                   If not fClearedCurrentPos then Begin
  1516.                     If (fStartPos.SX)>(fCurrentPos.SX) then Begin
  1517.                       X1:=(fCurrentPos.SX);
  1518.                       X2:=(fStartPos.SX);
  1519.                     end
  1520.                     else Begin
  1521.                       X2:=(fCurrentPos.SX);
  1522.                       X1:=(fStartPos.SX);
  1523.                     end;
  1524.                     If GetWindowPos(fStartPos.SY)>GetWindowPos(fCurrentPos.SY) then Begin
  1525.                       Y1:=GetWindowPos(fCurrentPos.SY);
  1526.                       Y2:=GetWindowPos(fStartPos.SY);
  1527.                     end
  1528.                     else begin
  1529.                       Y2:=GetWindowPos(fCurrentPos.SY);
  1530.                       Y1:=GetWindowPos(fStartPos.SY);
  1531.                     end;
  1532.                     Rectangle(X1,Y1,X2,Y2);
  1533.                   end
  1534.                   else
  1535.                     fClearedCurrentPos:=False;;
  1536.                   If X<(fStartPos.SX) then Begin
  1537.                     X1:=X;X2:=(fStartPos.SX);
  1538.                   end
  1539.                   else Begin
  1540.                     X2:=X;X1:=(fStartPos.SX);
  1541.                   end;
  1542.                   If Y<height-fStartPos.SY then Begin
  1543.                     Y1:=Y;Y2:=GetWindowPos(fStartPos.SY);
  1544.                   end
  1545.                   else Begin
  1546.                     Y2:=Y;Y1:=GetWindowPos(fStartPos.SY);
  1547.                   end;
  1548.                   Rectangle(X1,Y1,X2,Y2);
  1549.                 end;
  1550.               end;
  1551.  
  1552.           end;{Case}
  1553.           Pen.Mode:=OldMode;
  1554.           Pen.Style:=oldStyle;
  1555.           Brush.Style:=oldBStyle;
  1556.           Pen.Color:=OldColor;
  1557.           If (fToolMode = tlSelect) and (fMoveMode=mmNone) then DrawThePloy;
  1558.         end;
  1559.      end else
  1560.      Begin
  1561.  
  1562.      end;
  1563. end;
  1564. (*************************************************************)
  1565. Procedure TCustomOpenGLWindow.DrawHUDDisplay;
  1566.     //draw the HUD screen data
  1567.   Var OldStyle:tBrushStyle;
  1568.       w,h:LongInt;
  1569.   Begin
  1570.    if fHRC=0 then exit;
  1571.    If fGDIGeneric then
  1572.    Begin
  1573.        OldStyle:=fCanvas.Brush.Style;
  1574.        fCanvas.Brush.Style:=bsClear;
  1575.        If fViewerTimer.enabled then
  1576.        If fHUDon then
  1577.         Begin
  1578.            DoHUDUpdate;
  1579.           // call user HUD update
  1580.            If Assigned(fOnHUDUpdate) then fOnHUDUpDate(self,fCanvas,fGDIGeneric);
  1581.         end;
  1582.      //tidy up
  1583.         fCanvas.Brush.Style:=OldStyle;
  1584.     end else
  1585.     Begin
  1586.      // set up the GLCanvas
  1587.       glCanvas.f3DMode:= False;
  1588.       //set background state
  1589.       CallList(fGeneralLists+dlForeGround);
  1590.  
  1591.       glMatrixMode(GL_PROJECTION);
  1592.       glPushMatrix;
  1593.       glLoadIdentity;
  1594.       If not fDrawToOther then
  1595.        Begin
  1596.          w:=width;h:=height;
  1597.        end else
  1598.        Begin
  1599.          w:=fOtherWidth;h:=fOtherHeight;
  1600.        end;
  1601.       gluOrtho2D(-w/2,w/2,-h/2,h/2);
  1602.  
  1603.       glMatrixMode(GL_MODELVIEW);
  1604.       glPushMatrix();
  1605.       glLoadIdentity;
  1606.       glTranslatef(-w/2,-h/2,1);
  1607.  
  1608.       If fHUDon then
  1609.         Begin
  1610.            DoHUDUpdate;
  1611.           // call user HUD update
  1612.            If Assigned(fOnHUDUpdate) then fOnHUDUpDate(self,fCanvas,fGDIGeneric);
  1613.         end;
  1614.      // tidy up
  1615.       glCanvas.f3DMode:= True;
  1616.       glPopMatrix();
  1617.       glMatrixMode(GL_PROJECTION);
  1618.       glPopMatrix;
  1619.       glMatrixMode(GL_MODELVIEW);
  1620.     end;
  1621.   end;
  1622. (*************************************************************)
  1623. Function TCustomOpenGLWindow.UpdateExtraScreenCoordsLabel:String;
  1624. var
  1625.   aStr,S1:String;
  1626.     Procedure GetDEltaData(aList:tList);
  1627.      Var DeltaX,DeltaY,DeltaZ,LastDistance,B,A:Double;
  1628.          lp1:tLinkPoint;
  1629.          P1,P2:tGLPoint;
  1630.       Begin
  1631.          If aList.Count=0 then exit;
  1632.          Lp1:=aList.Items[aList.count-1] ;
  1633.          DeltaX  := MouseX-LP1.X;     //dif in X
  1634.          DeltaY  := MouseY-LP1.Y;     //dif in Y
  1635.          DeltaZ  := MouseZ-LP1.Z;     //dif in Z
  1636.          LastDistance:=sqrt( sqr(DeltaX)+
  1637.                              sqr(DeltaY)+
  1638.                              sqr(DeltaY));  //Real dist
  1639.          P1.X:=LP1.X;P2.X:=MouseX;
  1640.          P1.Y:=LP1.Y;P2.Y:=MouseY;
  1641.          P1.Z:=LP1.Z;P2.Z:=MouseZ;
  1642.          aStr:=aStr+'DX= ';
  1643.          Str(DeltaX:-1:1,S1);
  1644.          aStr:=aStr+s1+', DY= ';
  1645.          Str(DeltaY:-1:1,S1);
  1646.          aStr:=aStr+s1+', DZ= ';
  1647.          Str(DeltaZ:-1:1,S1);
  1648.          aStr:=aStr+s1+', Dist= ' ;
  1649.          Str(LastDistance:-1:1,S1);
  1650.          iF BearingAndAzimuth(P1,P2,B,A)   then
  1651.            Begin
  1652.             aStr:=aStr+s1+', Br= ' ;
  1653.             Str(B:-1:1,S1);
  1654.             aStr:=aStr+s1+', Az= ' ;
  1655.             Str(A:-1:1,S1);
  1656.             aStr:=aStr+s1;
  1657.            end else  aStr:=aStr+s1;
  1658.  
  1659.       end;
  1660.   Begin
  1661.   If Assigned(fExtraData) then
  1662.    begin
  1663.     aStr:='';
  1664.     If fMoveMode<>mmNone then
  1665.     Case fMoveMode of
  1666.      mmMeasure: GetDeltaData(fMovePoints);
  1667.     end
  1668.     else
  1669.       If fToolMode<>tlNone then
  1670.        Case fToolMode of
  1671.          tlLine:GetDeltaData(fSelectPoints);
  1672.        end;
  1673.     fExtraData.Text:=aStr;
  1674.     Result:=aStr;
  1675.    end;
  1676.   end;
  1677. (*************************************************************)
  1678. Function TCustomOpenGLWindow.UpdateScreenCoordsLabel:String;
  1679. var
  1680.   aStr,S1:String;
  1681. Begin
  1682.   Result:='';
  1683.   If Assigned(fLocationLabel) then
  1684.   Begin
  1685.     Str(MouseX:-1:1,S1);
  1686.     aStr:=aStr+s1+', ';
  1687.     Str(MouseY:-1:1,S1);
  1688.     aStr:=aStr+s1+', ';
  1689.     Str(MouseZ:-1:1,S1);
  1690.     aStr:=aStr+s1;
  1691.     fLocationLabel.Text:=aStr;
  1692.     Result:=aStr;
  1693.   end;
  1694. end;
  1695. (*************************************************************)
  1696. Procedure TCustomOpenGLWindow.CopyCurrentView;
  1697.     // make a copy of the curent viewing position
  1698. Begin
  1699.   fPreviousViews.Add(fViewer.Duplicate);
  1700. end;
  1701. (*************************************************************)
  1702. Procedure TCustomOpenGLWindow.RestoreLastView;
  1703.     // restore the last viewing position
  1704. Begin
  1705.   If fPreviousViews.Count=0 then exit;
  1706.   fViewer.CopyValuesFrom(fPreviousViews.Items[fPreviousViews.Count-1]);
  1707.   TViewFrame(fPreviousViews.Items[fPreviousViews.Count-1]).free;
  1708.   fPreviousViews.Delete(fPreviousViews.Count-1);
  1709.   SetUpViewingFrustrum;
  1710.   Repaint;
  1711.  end;
  1712. (*************************************************************)
  1713. Function TCustomOpenGLWindow.GetScale:Single;
  1714.      Begin
  1715.        Result:=fViewer.Scale;
  1716.      end;
  1717. (*************************************************************)
  1718. Function TCustomOpenGLWindow.getXCubeSize:Double;
  1719.   Begin
  1720.     Result:=fViewer.XRadius;
  1721.   end;
  1722. (*************************************************************)
  1723. Function TCustomOpenGLWindow.getYCubeSize:Double;
  1724.   Begin
  1725.     Result:=fViewer.YRadius;
  1726.   end;
  1727. (*************************************************************)
  1728. Function TCustomOpenGLWindow.getZCubeSize:Double;
  1729.   Begin
  1730.     Result:=fViewer.ZRadius;
  1731.   end;
  1732. (*************************************************************)
  1733. Function TCustomOpenGLWindow.GetAnimation:Boolean;
  1734.   Begin
  1735.     Result:=fAnimationRunning;
  1736.   end;
  1737. (*************************************************************)
  1738. Procedure TCustomOpenGLWindow.SetAnimation(aVal:Boolean);
  1739.   Begin
  1740.     If aVal then StartAnimation else StopAnimation;
  1741.     fAnimationRunning:=aVal;
  1742.   end;
  1743. (*************************************************************)
  1744. procedure TCustomOpenGLWindow.SetViewportGridOn(aVal:Boolean);
  1745.   Begin
  1746.     If aVal=fViewportGridOn then exit;
  1747.     fViewportGridOn:=aVal;
  1748.     Repaint;
  1749.   end;
  1750. (*************************************************************)
  1751. procedure TCustomOpenGLWindow.SetViewportGridTextOn(aVal:Boolean);
  1752.  Begin
  1753.     If aVal=fViewportGridTextOn then exit;
  1754.     fViewportGridTextOn:=aVal;
  1755.     Repaint;
  1756.  end;
  1757. (*************************************************************)
  1758. procedure TCustomOpenGLWindow.SetCursor3D(aVal:Boolean);
  1759.   Var P1,P2,P3:tGLPoint;
  1760.   Begin
  1761.     If aVal=f3DCursorOn then exit;
  1762.     f3DCursorOn:=aVal;
  1763.     CalcCursorPlane(P1,P2,P3,False);
  1764.     RePaint;
  1765.   end;
  1766. (*************************************************************)
  1767.  procedure TCustomOpenGLWindow.SetStdDisplayList(aVal:Boolean);
  1768.    Begin
  1769.      If fStdDisplayList=aVal then exit;
  1770.      fStdDisplayList:=aVal;
  1771.      iF fStdDisplayList then
  1772.        Begin
  1773.          If not EnableGL then
  1774.            Begin
  1775.             fStdDisplayList:=False;
  1776.             exit;
  1777.            end;
  1778.          SetUpStdDisplayLists;
  1779.          BuildDisplayLists;
  1780.        end else
  1781.        Begin
  1782.          ShutDownStdDisplayLists;
  1783.        end;
  1784.      Repaint;
  1785.    end;
  1786. (*************************************************************)
  1787. Procedure TCustomOpenGLWindow.StartAnimation;
  1788.   // start the animation timer
  1789.   Begin
  1790.     If (csDesigning in ComponentState) then
  1791.      Begin
  1792.       StopAnimation;
  1793.       exit;
  1794.      end;
  1795.     If Assigned(fAnimateTimer) then
  1796.      Begin
  1797.       fLastRenderMode:=fRenderMode;
  1798.       fRenderMode    :=rmAnimation;
  1799.       fAnimateTimer.Enabled:=True;
  1800.       fViewPtIndex:=0;
  1801.       fClockStart    :=TimeGetTime;
  1802.      end;
  1803.   end;
  1804. (*************************************************************)
  1805. Procedure TCustomOpenGLWindow.StopAnimation;
  1806.   // stop the animation timer
  1807.   Begin
  1808.     If Assigned(fAnimateTimer) then
  1809.       Begin
  1810.        fAnimateTimer.Enabled:=False;
  1811.        fRenderMode:=fLastRenderMode;
  1812.       end; 
  1813.   end;
  1814. (*************************************************************)
  1815. Procedure TCustomOpenGLWindow.StartViewerAnimation;
  1816.   // start the animation timer
  1817. Begin
  1818.   If assigned(fViewerTimer) then
  1819.    Begin
  1820.     fViewerTimer.Enabled:=True;
  1821.     fViewAnimation:=True;
  1822.     fViewClockStart:=TimeGetTime;
  1823.    end;
  1824. end;
  1825. (*************************************************************)
  1826. Procedure TCustomOpenGLWindow.StopViewerAnimation;
  1827.   // stop the animation timer
  1828. Begin
  1829.   If assigned(fViewerTimer) then
  1830.    Begin
  1831.       fViewerTimer.Enabled:=False;
  1832.       fViewAnimation:=False;
  1833.    end;
  1834. end;
  1835. (******* ******************************************************)
  1836. Function TCustomOpenGLWindow.ProjectOnScreen(aPt:tGLPoint;
  1837.                           var ScreenPt:TPoint;
  1838.                           var ZDepth:GLDouble):Boolean;
  1839. {Project the given point onto the screen of the given RC}
  1840.   Var  Sc1,Sc2,ZD:GLDouble;
  1841.        MP,PP:pGLDouble;
  1842.        VP:PGLint;
  1843.   Begin
  1844.     Result:=False;
  1845.     MP:=pGLDouble(@fModelMatrix);
  1846.     PP:=pGLDouble(@fprojMatrix);
  1847.     VP:=pGLInt(@fViewPort);
  1848.     If (gluProject(aPt.X,aPt.Y,aPt.Z,MP,PP,VP,Sc1,Sc2,ZD)=GL_True) then
  1849.       Begin
  1850.         If (abs(SC1)>High(LongInt)) or (abs(sc2)>High(LongInt)) then exit;
  1851.         ScreenPt.X:=Round(SC1);
  1852.         ScreenPt.Y:=Round(SC2);
  1853.         ZDepth:=ZD;
  1854.         Result:=True;
  1855.       end;
  1856.   end;
  1857. (******* ******************************************************)
  1858. Function TCustomOpenGLWindow.ProjectLineOnScreen (var aPt1,aPt2 : tGLPoint):Boolean;
  1859.  // project the given 3D line ont the screen returning the modified tGLPoint
  1860.  // Values.  Return true if sucessful
  1861.   Var CRM  : GLint;
  1862.       TBuff: Array[0..7] of GLfloat;
  1863.       Res  : LongInt;
  1864.   Begin
  1865.      REsult:=False;
  1866.      EnableGL;
  1867.      glGetIntegerv(GL_RENDER_MODE,@CRM);
  1868. // if not in the right mode then quit
  1869.      If CRM<>GL_RENDER then exit;
  1870.  
  1871.      FillChar(tBuff,SizeOf(tBuff),0);
  1872. // select the buffer
  1873.      glFeedbackBuffer(8,GL_3D,@tBuff);
  1874. // set the mode
  1875.      glRenderMode(GL_FEEDBACK);
  1876. // draw the line to the buffer
  1877.      GLBegin(GL_Lines);
  1878.        glVertex3Dv(@aPt1);
  1879.        glVertex3dv(@aPt2);
  1880.      glEnd;
  1881. // switch back the mode
  1882.      Res := glRenderMode(GL_RENDER);
  1883.      If Res<0 then exit;
  1884. // if failed to draw then exit
  1885.      If (tBuff[0]=0) then exit;
  1886. // get the data
  1887.      aPt1.X:=tBuff[1];
  1888.      aPt1.Y:=tBuff[2];
  1889.      aPt1.Z:=tBuff[3];
  1890.  
  1891.      aPt2.X:=tBuff[4];
  1892.      aPt2.Y:=tBuff[5];
  1893.      aPt2.Z:=tBuff[6];
  1894. // set result
  1895.      Result:=True;
  1896.   end;
  1897. (******* ******************************************************)
  1898. Function TCustomOpenGLWindow.GetFromScreen(var aPt:tGLPoint;
  1899.                         ScreenPt:TPoint;
  1900.                         ZDepth:GLDouble):Boolean;
  1901.   Var  Sc1,Sc2,X,Y,Z:GLDouble;
  1902.        MP,PP:pGLDouble;
  1903.        VP:PGLint;
  1904.   Begin
  1905.     Result:=False;
  1906.     SC1:=ScreenPt.X;
  1907.     SC2:=ScreenPt.Y;
  1908.     MP:=pGLDouble(@fModelMatrix);
  1909.     PP:=pGLDouble(@fprojMatrix);
  1910.     VP:=pGLInt(@fViewPort);
  1911.     If (gluUnProject(Sc1,Sc2,ZDepth,MP,PP,VP,X,Y,Z)=GL_True)then
  1912.      Begin
  1913.        Result:=True;
  1914.        aPt.X:=X;
  1915.        aPt.Y:=Y;
  1916.        aPt.Z:=Z;
  1917.      end;
  1918.   end;
  1919. (*************************************************************)
  1920.  Procedure TCustomOpenGLWindow.GetFrontBackPoints(const XVal,YVal:Longint;ZVal,ticht:Double;
  1921.                              var Point,BackPt,FrontPt,ticPt:tGLPoint);
  1922.      // get the data to be able to draw line from front to back
  1923.      Var ScnPt: TPoint;
  1924.  
  1925.      Begin
  1926.          ScnPt.X:=XVal;
  1927.          ScnPt.Y:=YVal;
  1928.          GetFromScreen(Point,ScnPt,ZVal);
  1929.          GetFromScreen(BackPt,ScnPt,1.0);
  1930.          GetFromScreen(FrontPt,ScnPt,0.0);
  1931.          ScnPt.Y:=ScnPt.Y+Round(ticht);
  1932.          GetFromScreen(ticPt,ScnPt,ZVal);
  1933.      end;
  1934. (*************************************************************)
  1935. procedure TCustomOpenGLWindow.MouseDown(Button: TMouseButton; Shift: TShiftState;
  1936.                                   X, Y: Integer);
  1937.  Var ReDrawNeeded:Boolean;
  1938.   Procedure DoLeftButtonDown;
  1939.   Begin
  1940.     XDif:=0;  XStart:=X;
  1941.     YDif:=0;  YStart:=Y;
  1942.     fLButtonDown:=True;
  1943.  
  1944.     Case fMoveMode of
  1945.         mmMoveToPt      : DoMove;
  1946.         mmLookAt,mmRotate,
  1947.         mmwalk,mmFly,mmslide,
  1948.         mmTwist         : StartViewerAnimation;
  1949.         mmMeasure       : DoMeasure(X,Y);
  1950.         mmModifyScreenZ : StartViewerAnimation;
  1951.         mmLookAtPt      : DoLookAtPt;
  1952.     end;
  1953. // handle selection
  1954.     If (fToolMode=tlSelect) then DoOnSelectDown(X,Y,ReDrawNeeded);
  1955.  
  1956.     If ReDrawNeeded then repaint;
  1957.   // store copy of viewer
  1958.     If fMoveMode<>mmNone then CopyCurrentView;
  1959.   end;
  1960.  
  1961. Begin
  1962.   fShift:=Shift;
  1963.   EnableGL;
  1964.   If not (csDesigning in Componentstate) then
  1965.   Begin
  1966.  // modify the screen z position based on the current cursor plane
  1967.     UpDateScreenZ(X,Y,fViewer);
  1968.  
  1969.     fCurrentPos.SetWinScreenPt(X,y,height,fViewer.ScreenZ);
  1970.     ConvertScreenToWorld(fCurrentPos,False);
  1971.  
  1972.     Case Button of
  1973.     // do left button stuff
  1974.       mbLeft : DoLeftButtonDown;
  1975.       mbRight: fRButtonDown:=True;
  1976.     end;  {Case}
  1977.  
  1978.     fStartPos.SetWinScreenPt(X,y,height,fViewer.ScreenZ);
  1979.     ConvertScreenToWorld(fStartPos,False);
  1980.  
  1981.     fViewClockStart:=TimeGetTime;
  1982.   end;
  1983.   // check for GLErrors
  1984.   GetError;
  1985.  
  1986.   Inherited ;
  1987. end;
  1988. (*************************************************************)
  1989.  Procedure TCustomOpenGLWindow.UpDateScreenZ(X,Y:Longint;aViewer:TViewFrame);
  1990.    Begin
  1991.      If not f3DCursorOn then exit;
  1992.      If not assigned(aViewer) then exit;
  1993.      If (fCursorPlaneRec.C=0) or not fCursorPlaneRec.IsValid then exit;
  1994.      With fCursorPlaneRec do
  1995.        aViewer.ScreenZ:=(D-(A*X)-(B*(height-Y)))/C;
  1996.   end;
  1997. (*************************************************************)
  1998.  Procedure TCustomOpenGLWindow.CalcCursorPlane(aP1,aP2,aP3:tGLPoint;UseCustom:Boolean);
  1999.   // calc the required values for the cursor plane from P1,P2,P3);
  2000.     Var P1,P2,P3:tGLPoint;
  2001.         t1,t2,t3:tPoint;
  2002.         z1,z2,z3:GLDouble;
  2003.   Begin
  2004.     If UseCustom then
  2005.     Begin
  2006.      P1:=aP1;
  2007.      P2:=aP2;
  2008.      P3:=aP3;
  2009.     end else
  2010.     Case fViewMode of
  2011.       vmLookDown,vmLookUp:
  2012.         Begin
  2013.           //XY plane
  2014.              With P1 do begin X:=0;Y:=0;Z:=fHome.Z; end;
  2015.              With P2 do begin X:=CursorPlaneSide;Y:=0;Z:=fHome.Z; end;
  2016.              With P3 do begin X:=0;Y:=CursorPlaneSide;Z:=fHome.Z; end;
  2017.         end;
  2018.       vmLookWest,vmLookEast:
  2019.         Begin
  2020.           //YZ plane
  2021.              With P1 do begin X:=fHome.X;Y:=0;Z:=0; end;
  2022.              With P2 do begin X:=fHome.X;Y:=0;Z:=CursorPlaneSide; end;
  2023.              With P3 do begin X:=fHome.X;Y:=CursorPlaneSide;Z:=0; end;
  2024.         end;
  2025.       vwLookNorth,vmLookSouth:
  2026.         Begin
  2027.           //XZ plane
  2028.              With P1 do begin X:=0;Y:=fHome.Y;Z:=0; end;
  2029.              With P2 do begin X:=CursorPlaneSide;Y:=fHome.Y;Z:=0; end;
  2030.              With P3 do begin X:=0;Y:=fHome.Y;Z:=CursorPlaneSide; end;
  2031.         end;
  2032.        end;{Case}
  2033.      If ProjectOnScreen(P1,t1,z1)and
  2034.         ProjectOnScreen(P2,t2,z2)and
  2035.         ProjectOnScreen(P3,t3,z3)then
  2036.       Begin
  2037.         CalcPlaneEq(t1.x,t1.y,z1,
  2038.                     t2.x,t2.y,z2,
  2039.                     t3.x,t3.y,z3,
  2040.                     fCursorPlaneRec);
  2041.       end;
  2042.     end;
  2043. (*************************************************************)
  2044. procedure TCustomOpenGLWindow.MouseMove(Shift: TShiftState; X, Y: Integer);
  2045. var
  2046.   sDist:Single;
  2047.   aPt:tGLPoint;
  2048.   ReDrawNeeded:Boolean;
  2049. Begin
  2050.   fShift:=Shift;
  2051.   ReDrawNeeded:=False;
  2052.   If Focused then
  2053.    Begin
  2054.  
  2055.     If fSnapOn then
  2056.     Begin
  2057.       aPt.X:=fCurrentPos.X;
  2058.       aPt.Y:=fCurrentPos.Y;
  2059.       aPt.Z:=fCurrentPos.Z;
  2060.       sDist:=DistanceBetween(fSnapPoint,aPt);
  2061.       If sDist<SnapDistance then
  2062.         SnapToPoint(fSnapPoint.X,fSnapPoint.Y,fSnapPoint.Z,Hint)
  2063.       else
  2064.         fSnapOn:=False;
  2065.     end;
  2066.  
  2067.     DrawToolGuides(X,Y);
  2068.  //draw the stuff for the current Tool mode
  2069.     DrawMoveGuides(X,Y);
  2070.  // draw the screen stuff for the current move mode
  2071.     UpDateScreenZ(X,Y,fViewer);
  2072.     fCurrentPos.SetWinScreenPt(X,y,height,fViewer.ScreenZ);
  2073.     ConvertScreenToWorld(fCurrentPos,False);
  2074.  
  2075.  
  2076.     If not (csDesigning in Componentstate) then
  2077.     Begin
  2078.      If fGDIGeneric then Draw3DGDICursor(glGridType(fViewmode))
  2079.       else repaint;
  2080.       If fLButtonDown and
  2081.          ((abs(X-fStartPos.SX)>MouseMoveTol) or
  2082.           (abs(Y-fStartPos.SY)>MouseMoveTol)) then
  2083.       Begin
  2084.         XDif:=(X-xStart);
  2085.         YDif:=(Y-yStart);
  2086.  
  2087.         Case fToolMode of
  2088.          tlNone:;
  2089.          tlSelect: If (fSelectState<>stnone) then DoSelectedMove(X,Y,ReDrawNeeded);
  2090.         end;
  2091.         If ReDrawNeeded then repaint; // should not be true
  2092.       end     {if flButtonDown}
  2093.       else
  2094.       Begin
  2095.         UpdateScreenCoordsLabel;
  2096.         UpdateExtraScreenCoordsLabel;
  2097.       end;
  2098.     end;  {Running}
  2099.   end  {if Focussed}
  2100.   else
  2101.       Begin
  2102.         UpdateScreenCoordsLabel;
  2103.         UpdateExtraScreenCoordsLabel;
  2104.       end;
  2105.   {Draw cursor}
  2106.   Inherited MouseMove(Shift,X,Y);
  2107. end;
  2108. (*************************************************************)
  2109. procedure TCustomOpenGLWindow.MouseUp(Button: TMouseButton; Shift: TShiftState;
  2110.  X, Y: Integer);
  2111. Var RedrawNeeded:Boolean;
  2112. begin
  2113.   If canFocus and not focused then SetFocus;
  2114.   fShift:=Shift;
  2115.   If not (csDesigning in Componentstate)then
  2116.    Begin
  2117.     UpDateScreenZ(X,Y,fViewer);
  2118.     fCurrentPos.SetWinScreenPt(X,y,height,fViewer.ScreenZ);
  2119.     ConvertScreenToWorld( fCurrentPos,False);
  2120.  
  2121.     fLastPos.SetWinScreenPt(X,y,height,fViewer.ScreenZ);
  2122.     ConvertScreenToWorld(fLastPos,False);
  2123.  
  2124.     If Button=MbLeft then
  2125.      Begin
  2126.       XDif:=(X-xStart);
  2127.       YDif:=(Y-yStart);
  2128.  
  2129.       If fLButtonDown and (fToolMode=tlSelect)and
  2130.          (fSelectState<>stnone) then DoSelectMoveFinish(X,Y,RedrawNeeded);
  2131.      { If ReDrawNeeded then repaint;}
  2132.  
  2133.       If (fToolMode<>tlNone) and (fMoveMode=mmNone) and
  2134.           focused then  fSelectPoints.Add(fStartPos.Duplicate);
  2135.  
  2136.       Case fMoveMode of
  2137.         mmZoom : DoZoom;
  2138.         mmPan  : DoPan;
  2139.         mmLookAt,
  2140.         mmFly,
  2141.         mmRotate,
  2142.         mmSlide,
  2143.         mmWalk,
  2144.         mmTwist : StopviewerAnimation;
  2145.         mmModifyScreenZ:StopViewerAnimation;
  2146.       end; {case}
  2147.  
  2148.       fLButtonDown:=false;
  2149.       Repaint;
  2150.     end
  2151.     else
  2152.       If Button=mbRight then fRButtonDown:=false;
  2153.   end;
  2154.   Inherited MouseUp(Button,Shift,X,Y);
  2155. end;
  2156. (*************************************************************)
  2157. procedure TCustomOpenGLWindow.Click;
  2158. begin
  2159.   If CanFocus and Not focused then SetFocus;
  2160.   Inherited Click;
  2161. end;
  2162. (*************************************************************)
  2163.   procedure TCustomOpenGLWindow.DblClick;
  2164.   Begin
  2165.  
  2166.      Inherited DblClick;
  2167.   end ;
  2168. (*************************************************************)
  2169. Function TCustomOpenGLWindow.WX:GLDouble;
  2170. Begin
  2171.   Result:=fCurrentPos.X;
  2172. end;
  2173. (*************************************************************)
  2174. Function TCustomOpenGLWindow.WY:GLDouble;
  2175. Begin
  2176.   Result:=fCurrentPos.Y;
  2177. end;
  2178. (*************************************************************)
  2179. Function TCustomOpenGLWindow.WZ:GLDouble;
  2180. Begin
  2181.   Result:=fCurrentPos.Z;
  2182. end;
  2183. (*************************************************************)
  2184. Function TCustomOpenGLWindow.GetGLPerPixel:GLFloat;
  2185. Begin
  2186. //to do need to return a valid value if in perspective mode if possible
  2187.   {If fViewer.Perspective then result:=1 else }result:=fGLperPixel;
  2188. end;
  2189. (*************************************************************)
  2190. Procedure TCustomOpenGLWindow.GLSessionSetUp ;
  2191.    {Set up when GL session is started}
  2192. Begin
  2193.   If fHRC=0 then exit;
  2194.   GLLock;
  2195.   If fBackColor=glWhiteBkgd then
  2196.     glClearColor(1.0,1.0,1.0,1.0)
  2197.   else
  2198.     glClearColor(0.0,0.0,0.0,1.0);
  2199.   glClearIndex(0.0);
  2200.   glClearDepth(1.0);
  2201.   glPixelStorei(GL_Unpack_Alignment,1);
  2202.     //specific for windows and byte alignment
  2203.   {glBlendFunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA);}
  2204.   glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT or GL_STENCIL_BUFFER_BIT);
  2205.  
  2206.   glDisable(GL_SCISSOR_TEST);
  2207.   glDisable(GL_BLEND);
  2208.  
  2209.   If not assigned(fShareGL) and fStdDisplayList then
  2210.     BuildDisplayLists;
  2211. // set up the basic view stuff
  2212.   ReSetView(True);
  2213.  
  2214.   fValidBuffer:=False;
  2215.   glUnLock;
  2216. end;
  2217. (*************************************************************)
  2218. Procedure TCustomOpenGLWindow.GLRender2DForeGround;
  2219.   {Allow for the 2D drawing with in the buffer
  2220.    Is called after the 3D render}
  2221.    var w,h:Longint;
  2222. Begin
  2223.  // set up the GLCanvas
  2224.   glCanvas.f3DMode:= False;
  2225.   //set background state
  2226.   CallList(fGeneralLists+dlForeGround);
  2227.  
  2228.   glMatrixMode(GL_PROJECTION);
  2229.   glPushMatrix;
  2230.   glLoadIdentity;
  2231.   If not fDrawToOther then
  2232.    Begin
  2233.      w:=width;
  2234.      h:=height;
  2235.    end else
  2236.    Begin
  2237.      w:=fOtherWidth;
  2238.      h:=fOtherHeight;
  2239.    end;
  2240.   gluOrtho2D(-w/2,w/2,-h/2,h/2);
  2241.  
  2242.   glMatrixMode(GL_MODELVIEW);
  2243.   glPushMatrix();
  2244.   glLoadIdentity;
  2245.   glTranslatef(-w/2,-h/2,1);
  2246.  
  2247.   DoGLRender2Dforeground;
  2248.   If Assigned(fOn2DForeGroundRender) then
  2249.     fOn2DForeGroundRender(Self,fRenderMode,glCanvas);
  2250.  
  2251. // draw the controls borders
  2252.   If not fDrawToOther then DrawBorder;
  2253. // tidy up
  2254.   glCanvas.f3DMode:= True;
  2255.   glPopMatrix();
  2256.   glMatrixMode(GL_PROJECTION);
  2257.   glPopMatrix;
  2258.   glMatrixMode(GL_MODELVIEW);
  2259.  
  2260. end;
  2261. (*************************************************************)
  2262. Procedure TCustomOpenGLWindow.GLRenderWindow(DoSwap:Boolean);
  2263. Begin
  2264.   fCanvas.Lock;
  2265. // lock the canvas from others
  2266.   Try
  2267.     If not fRebuildneeded then
  2268.     Begin
  2269.      If DoSwap then
  2270.        Begin
  2271.   //If swap copy is enabled then swap buffers else need to rebuild
  2272.          If fpfd_Swap_Copy and fValidBuffer and not fDrawToOther then
  2273.   //some systems allow for a buffer swap others not
  2274.             SwapBuffers(fRenderDC)
  2275.           // swapbuffers is the Windows implementation
  2276.          else
  2277.             fRebuildNeeded:=True;
  2278.        end;//doswap
  2279.     end;
  2280.  
  2281.   If fRebuildNeeded then
  2282.     Begin
  2283.    //Tidy up extra construction lines
  2284.       Clear3DCursor;
  2285.       DoMoveTidyUp;
  2286.  
  2287.       if f3DCursorOn and not fGDIGeneric then Cursor:=crnone;
  2288.    //setup the cursors
  2289.  
  2290.       fRebuildNeeded:=False;
  2291.       fValidBuffer  :=False;
  2292.   //rest the flags
  2293.  
  2294.       If doswap then ClearScreen;
  2295.   // clear the Open GL screen buffers
  2296.  
  2297.       SetUpViewingTransform;
  2298.  // set up the viewing transform
  2299.  
  2300.       GetViewPortGrid(glGridType(fViewmode),20);
  2301.  // calculate the reference grid data
  2302.  
  2303.       SaveState(stDrawing);
  2304.       GLRender2DBackGround;
  2305.       RestoreState;
  2306.  // draw background - note save and restore of GL state
  2307.  
  2308.       glPushMatrix();
  2309.       SaveState(stAll);
  2310.  // set up the modelview transform for 3D drawing
  2311.       glListBase(0);
  2312.  // make sure Display list base is zero
  2313.       Case  fRenderMode of
  2314.        rmQuick: CallList(fGeneralLists+dlQuickRenderMode);
  2315.        else CallList(fGeneralLists+dlFullRenderMode);
  2316.       end;
  2317.   // set GL state to handle current render mode
  2318.       Do3DRenderScene;
  2319.   // do the 3D rendering
  2320.       DrawSelectedPoints;
  2321.   //draw points selected via the tools
  2322.       DrawSimpleAxis;
  2323.   //draw the simple axis
  2324.       RestoreState;
  2325.       glPopMatrix();
  2326.   // tidy up after 3D render
  2327.  
  2328.       SaveState(stDrawing);
  2329.       GLRender2DForeGround;
  2330.       RestoreState;
  2331.   // Call the 2D paper space render rountine inc drawing border
  2332.  
  2333.       SaveState(stDrawing);
  2334.       DrawHUDDisplay;
  2335.       RestoreState;
  2336.   // need to tackle the HUD draw before the glflush swapbuffer
  2337.   //if not fGDIGeneric
  2338.  
  2339.       glFinish;
  2340.  // Flush the OpenGL Pipeline  and wait for it to finish
  2341.  
  2342.       If DoSwap then
  2343.       Begin
  2344.           If not fDrawToOther then
  2345.             Begin
  2346.                If SwapBuffers(fRenderDC) and fGDIGeneric and fpfd_Swap_Copy
  2347.                   then  fValidBuffer:=True;
  2348.             end;
  2349.       end;
  2350.    // once finished all the rendering to the Back Buffer then need
  2351.    // to swap the rendered scene into the front buffer
  2352.     end;
  2353.   Finally
  2354.     if f3DCursorOn and not fGDIGeneric then Cursor:=crdefault;
  2355.     fCanvas.UnLock;
  2356.    // unlock the canvas
  2357.   end;
  2358. end;
  2359. (*************************************************************)
  2360. Procedure TCustomOpenGLWindow.GLRender2DBackGround;
  2361.   {Allow for the 2D drawing with in the buffer
  2362.    Is called after the 3D render}
  2363.   var w,h:LongInt;
  2364.   Begin
  2365.  
  2366.  // set up the GLCanvas
  2367.   glCanvas.f3DMode:= False;
  2368.   //set background state
  2369.   CallList(fGeneralLists+dlBackground);
  2370.  
  2371.   If not fDrawToOther then
  2372.    Begin
  2373.      w:=width;
  2374.      h:=height;
  2375.    end else
  2376.    Begin
  2377.      w:=fOtherWidth;
  2378.      h:=fOtherHeight;
  2379.    end;
  2380.  
  2381.   glMatrixMode(GL_PROJECTION);
  2382.   glPushMatrix;
  2383.   glLoadIdentity;
  2384.   gluOrtho2D(-w/2,w/2,-h/2,h/2);
  2385.  
  2386.   glMatrixMode(GL_MODELVIEW);
  2387.   glPushMatrix();
  2388.   glLoadIdentity;
  2389.   glTranslatef(-w/2,-h/2,0);
  2390.  
  2391.   // draw the grid if needed
  2392.   If fViewportGridOn then DrawViewPortGrid(fViewportGridTextOn);
  2393.  
  2394.  // do the render stuff
  2395.   DoGLRender2Dbackground;
  2396.   If Assigned(fOn2DbackgroundRender) then
  2397.     fOn2DbackgroundRender(Self,fRenderMode,glCanvas);
  2398.  
  2399.   glCanvas.f3DMode:= True;
  2400.   glPopMatrix();
  2401.     //tidy up
  2402.   glMatrixMode(GL_PROJECTION);
  2403.   glPopMatrix;
  2404.   glMatrixMode(GL_MODELVIEW);
  2405. end;
  2406. (*************************************************************)
  2407.  // cals to be overridden in descendants
  2408.  Procedure TCustomOpenGLWindow.DoGLRender2DForeGround;
  2409.     {Render the stock platform or fixed background}
  2410.    begin
  2411.    end;
  2412. (*************************************************************)
  2413.  Procedure TCustomOpenGLWindow.Do3DRenderScene;
  2414.     {Render the scene - override MUST call inherited}
  2415.    begin
  2416.      Draw3DCursor(glGridType(fViewmode));
  2417.  
  2418.      If Assigned(f0nDrawRenderScene) then
  2419.         f0nDrawRenderScene(Self,fRenderMode,glCanvas);
  2420.    // call the assigned procedure
  2421.    end;
  2422. (*************************************************************)
  2423.  Procedure TCustomOpenGLWindow.DoGLRender2Dbackground;
  2424.     // draw the background in descendant}
  2425.    begin
  2426.    end;
  2427. (*************************************************************)
  2428.  Procedure TCustomOpenGLWindow.DoHUDUpdate;
  2429.    Procedure FrameRateString;
  2430.     Var s:String;
  2431.      Begin
  2432.        s:='';
  2433.        If fViewElapsedTime>0 then Str(1000/fViewElapsedTime:-1:1,s);
  2434.        fCanvas.TextOut(20,20,'Frame Rate = '+s+' fps');
  2435.      end;
  2436.    Procedure AnimateHUD;
  2437.     Var s,s1:String;
  2438.      Begin
  2439.        s:='0';
  2440.        If fElapsedTime>0 then Str(1000/fElapsedTime:-1:1,s);
  2441.        s1:= 'Animation Rate = '+s+' fps';
  2442.        fCanvas.TextOut(width-(fCanvas.TextWidth(s1)+20),20,s1);
  2443.      end;
  2444.    Procedure LookAtHUD;
  2445.      Begin
  2446.        FrameRateString;
  2447.      end;
  2448.    Procedure RotateHUD;
  2449.      Begin
  2450.        FrameRateString;
  2451.      end;
  2452.    Procedure FlyHUD;
  2453.      Begin
  2454.        FrameRateString;
  2455.      end;
  2456.  
  2457.    Procedure WalkHUD;
  2458.      Begin
  2459.        FrameRateString;
  2460.      end;
  2461.    Procedure SlideHUD;
  2462.      Begin
  2463.        FrameRateString;
  2464.      end;
  2465.    Procedure TwistHUD;
  2466.      Begin
  2467.        FrameRateString;
  2468.      end;
  2469.    Procedure MeasureHUD;
  2470.     Var s:String;
  2471.         aMeasRec:tMeasureRecord;
  2472.      Begin
  2473.        GetMeasurementData( aMeasRec );
  2474.        With aMeasRec do
  2475.         Begin
  2476.            Str(NoOfPoints:-1,s);
  2477.            fCanvas.TextOut(20,35, 'No Of Pts  = '+s);
  2478.            Str(LastDeltaX:-1:2,s);
  2479.            fCanvas.TextOut(20,50, 'DeltaX     = '+s);
  2480.            Str(LastDeltaY:-1:2,s);
  2481.            fCanvas.TextOut(20,65, 'DeltaY     = '+s);
  2482.            Str(LastDeltaZ:-1:2,s);
  2483.            fCanvas.TextOut(20,80, 'DeltaZ     = '+s);
  2484.            Str(LastDistance:-1:2,s);
  2485.            fCanvas.TextOut(20,95, 'Real Dist  = '+s);
  2486.            Str(Lastbearing:-1:2,s);
  2487.            fCanvas.TextOut(20,110,'Bearing    = '+s);
  2488.            Str(LastElevation:-1:2,s);
  2489.            fCanvas.TextOut(20,125,'Elevation  = '+s);
  2490.            Str(DistanceSum:-1:2,s);
  2491.            fCanvas.TextOut(20,140,'Perimeter  = '+s);
  2492.            Str(Area:-1:2,s);
  2493.            fCanvas.TextOut(20,155,'Area        = '+s);
  2494.            Str(CMX:-1:2,s);
  2495.            fCanvas.TextOut(20,170,'CMX        = '+s);
  2496.            Str(CMY:-1:2,s);
  2497.            fCanvas.TextOut(20,185,'CMY        = '+s);
  2498.            Str(CMZ:-1:2,s);
  2499.            fCanvas.TextOut(20,200,'CMZ        = '+s);
  2500.         end;
  2501.      end;
  2502.  
  2503.    begin
  2504.        If fGDIGeneric then
  2505.        Begin
  2506.          fCanvas.Brush.Style:=bsClear;
  2507.          fCanvas.Font.Color:=clLime;
  2508.          fCanvas.Pen.Color:=clLime;
  2509.  
  2510.          Case fMoveMode of
  2511.            mmLookAt : LookAtHUD;
  2512.            mmRotate : RotateHUD;
  2513.            mmFly    : FlyHUD;
  2514.            mmWalk   : WalkHUD;
  2515.            mmSlide  : SlideHUD;
  2516.            mmTwist  : TwistHUD;
  2517.            mmMeasure: MeasureHUD;
  2518.           end;
  2519.  
  2520.         If fRenderMode=rmAnimation then  AnimateHUD;
  2521.  
  2522.        end else
  2523.        Begin
  2524.  
  2525.        end;
  2526.    end;
  2527. (*************************************************************)
  2528.  Procedure TCustomOpenGLWindow.DoOnSelectDown(X,Y:Longint;Var ReDrawNeeded:Boolean);
  2529. // always call inherited if overriding
  2530.    Begin
  2531.       ReDrawNeeded:=False;
  2532.   // handle poly selection mode
  2533.       If fSelectState=stnone then fSelectState:=stButtonDown;
  2534.  
  2535.       If assigned(fOnSelectDown) then
  2536.        With fCurrentPos do
  2537.            fOnSelectDown(Self,SPt.X,SPt.Y,X,Y,Z,ReDrawNeeded,fSelectState);
  2538.    end;
  2539. (*************************************************************)
  2540.     Procedure TCustomOpenGLWindow.DoSelectedMove(X,Y:Longint;Var ReDrawNeeded:Boolean);
  2541.  // Used to manage the drag/stretch mouse move stuff
  2542.     Begin
  2543.       ReDrawNeeded:=False;
  2544. // handle poly selectioin mode
  2545.       If (fSelectState=stButtonDown) and
  2546.          ((abs(xDif)>20) or
  2547.           (abs(YDif)>20) )then
  2548.           Begin
  2549.             ClearSelectList;
  2550.             fSelectState:=stPoly;
  2551.             fSelectPoints.add(fStartPos.Duplicate);
  2552.           end;
  2553.       If assigned(fOnSelectMove) then
  2554.        With fCurrentPos do
  2555.            fOnSelectMove(Self,SPt.X,SPt.Y,X,Y,Z,ReDrawNeeded,fSelectState);
  2556.     end;
  2557.  (*************************************************************)
  2558.  Function TCustomOpenGLWindow.SelectPolyClosed:Boolean;
  2559.     // test fselectlist for 'closed' poly select
  2560.     Var
  2561.         i: LongInt;
  2562.         lamba:Double;
  2563.     Begin
  2564.        Result:=False;
  2565.        If (fSelectPoints.count<4) then exit;
  2566.       { check if line crosses to form polygon }
  2567.        i:=0;
  2568.        while (i<fSelectPoints.count-3)and not Result do
  2569.        begin
  2570.           Result:=intersects(fCurrentPos.Sx,
  2571.                          fCurrentPos.Sy,
  2572.                          TLinkPoint(fSelectPoints.Items[fSelectPoints.count-1]).sx,
  2573.                          TLinkPoint(fSelectPoints.Items[fSelectPoints.count-1]).sy,
  2574.                          TLinkPoint(fSelectPoints.Items[i]).sx,
  2575.                          TLinkPoint(fSelectPoints.Items[i]).sy,
  2576.                          TLinkPoint(fSelectPoints.Items[i+1]).sx,
  2577.                          TLinkPoint(fSelectPoints.Items[i+1]).sy,
  2578.                          lamba);
  2579.           inc(i);
  2580.         end;
  2581.     end;
  2582. (*************************************************************)
  2583. (*
  2584.  Procedure TCustomOpenGLWindow.CancelSelectPoly;
  2585.     //cancel the select poly and clear the fselectlist
  2586.     Begin
  2587.        ClearSelectList;
  2588.        fSelectState:=stNone;
  2589.     end;
  2590.  *)   
  2591. (*************************************************************)
  2592.  Function  TCustomOpenGLWindow.IsPointInsideSelectPoly(X,Y:LongInt):Boolean;
  2593.    Begin
  2594.      Result:=False;
  2595.      If fSelectPoints.Count=0 then exit;
  2596.      If fSelectState<>stPolyClosed then exit;
  2597.      Result:=IsPtInsideList(X,Y,fSelectPoints);
  2598.    end;
  2599. (*************************************************************)
  2600.  Function  TCustomOpenGLWindow.IsPointOutSideSelectPoly(X,Y:LongInt):Boolean;
  2601.    Begin
  2602.      Result:=not IsPointInsideSelectPoly(X,Y);
  2603.    end;
  2604. (*************************************************************)
  2605.   Procedure TCustomOpenGLWindow.DoSelectMoveFinish(X,Y:Longint;Var ReDrawNeeded:Boolean);
  2606.  // When a drag/stretch ids finished
  2607.     Begin
  2608.       ReDrawNeeded:=False;
  2609.   //handle poly select mode
  2610.       If (fSelectState=stPoly) and SelectPolyClosed  then
  2611.           fSelectState:=stPolyClosed;
  2612.  
  2613.       If assigned(fOnSelectUp) then
  2614.        With fCurrentPos do
  2615.            fOnSelectUp(Self,SPt.X,SPt.Y,X,Y,Z,ReDrawNeeded,fSelectState);
  2616.     end;
  2617. (*************************************************************)
  2618.  Procedure TCustomOpenGLWindow.DoCustomViewSetUp;
  2619.  // handle the setup of the ModelView Matrix for vmCustomview
  2620.    Begin
  2621.       If assigned(fOnCustomViewSetUp) then
  2622.          fOnCustomViewSetUp(Self);
  2623.    end;
  2624. (*************************************************************)
  2625. Procedure TCustomOpenGLWindow.DoAnimate(Sender:tObject);
  2626.     //called by the animate timer
  2627.   Var DoRepaint:Boolean;
  2628.       t:DWord;
  2629.  Begin
  2630.   t:= TimeGetTime;
  2631.   DoRepaint:=False;
  2632.   fElapsedTime:=t-fClockStart;
  2633.   If (fElapsedTime>30) or fFullFrameRate then
  2634.    Begin
  2635.     //Animate viewpoints
  2636.     If fAnimateViewPt and
  2637.        (fFutureViews.Count>0) and
  2638.        (fViewPtIndex<fFutureViews.Count-1)then
  2639.      Begin
  2640.       FViewer.CopyValuesFrom(fFutureViews.Items[fViewPtIndex]);
  2641.       DoRepaint:=True;
  2642.       Inc(fViewPtIndex);
  2643.       If fViewPtLoop and (fViewPtIndex=fFutureViews.Count-1) then
  2644.         fViewPtIndex:=0;
  2645.      end;
  2646.     If Assigned(fOnAnimate) then
  2647.       fOnAnimate(Self,fElapsedTime,DoRepaint);
  2648.    // up date screen data if required
  2649.     if fHUDon then DoHUDUpdate;
  2650.    // temporary to force an update
  2651.     DoRepaint:=True;
  2652.    end;
  2653.   fClockStart:=t;
  2654.   If DoRepaint then Repaint;
  2655. end;
  2656. (*************************************************************)
  2657. Procedure TCustomOpenGLWindow.DoViewerAnimate(Sender:tObject);
  2658.     //called by the view animate timer
  2659.  Var t:DWord;
  2660.     P1,P2,P3:tGLPoint;
  2661.  Begin
  2662.   t:= TimeGetTime;
  2663.   fViewElapsedTime:= t-fViewClockStart;
  2664.   If fFullFrameRate or (fViewElapsedTime>30) then
  2665.   Begin
  2666.     Case fMoveMode of
  2667.         mmMoveToPt  : DoMove;
  2668.         mmLookAt    : DoLookAt;
  2669.         mmRotate    : DoRotate;
  2670.         mmSlide     : DoSlide;
  2671.         mmWalk      : DoWalk;
  2672.         mmFly       : DoFly;
  2673.         mmTwist     : DoTwist;
  2674.         mmLookAtPt  : DoLookAtPt;
  2675.         mmModifyScreenZ:DoScreenZ;
  2676.     end;{Case}
  2677.     If fMoveMode<>mmNone then CalcCursorPlane(P1,P2,P3,False);
  2678.  
  2679.     fViewClockStart:= t;
  2680.   end;
  2681. end;
  2682. (*************************************************************)
  2683. Procedure TCustomOpenGLWindow.DrawMoveHint;
  2684.     // called during the GL draw
  2685.   Procedure DrawRotate;
  2686.   Var OldStyle: tBrushStyle;
  2687.       OldColor:tColor;
  2688.       X1,Y1,X2,Y2:LongInt;
  2689.   Begin
  2690.    If fGDIGeneric then
  2691.    Begin
  2692.     With fCanvas do
  2693.     Begin
  2694.       oldStyle:=Brush.Style;
  2695.       OldColor:=pen.Color;
  2696.       Brush.Style:=bsClear;
  2697.       pen.Color:=clLime;
  2698.       X1:=XStart+20;Y1:=YStart+20;
  2699.       X2:=XStart-20;Y2:=YStart-20;
  2700.       Ellipse( X1,Y1,X2,Y2);
  2701.       X1:=XStart+40;Y1:=YStart+40;
  2702.       X2:=XStart-40;Y2:=YStart-40;
  2703.       Ellipse( X1,Y1,X2,Y2);
  2704.       X1:=XStart+50;Y1:=YStart+50;
  2705.       X2:=XStart-50;Y2:=YStart-50;
  2706.       MoveTo(X1,YStart);LineTo(X2,YStart);
  2707.       MoveTo(XStart,Y1);LineTo(XStart,Y2);
  2708.       Brush.Style:=OldStyle;
  2709.       pen.Color:=OldColor;
  2710.     end;
  2711.    end else
  2712.    Begin
  2713.  
  2714.    end;
  2715.   end;
  2716.   Procedure DrawTwist;
  2717.   Var OldStyle: tBrushStyle;
  2718.       OldColor:tColor;
  2719.       X1,Y1,X2,Y2:LongInt;
  2720.   Begin
  2721.    If fGDIGeneric then
  2722.    Begin
  2723.     With fCanvas do
  2724.     Begin
  2725.       oldStyle:=Brush.Style;
  2726.       OldColor:=pen.Color;
  2727.       Brush.Style:=bsClear;
  2728.       pen.Color:=clLime;
  2729.  
  2730.       X1:=XStart+50; X2:=XStart-50;
  2731.       Y1:=YStart+10; Y2:=YStart-10;
  2732.       MoveTo(Xstart,Y1); LineTo(XStart,Y2);
  2733.       Y1:=YStart+5; Y2:=YStart-5;
  2734.       MoveTo(X1,Y1); LineTo(X1,Y2);
  2735.       MoveTo(X1,YStart); LineTo(X2,YStart);
  2736.       MoveTo(X2,Y1); LineTo(X2,Y2);
  2737.  
  2738.       Brush.Style:=OldStyle;
  2739.       pen.Color:=OldColor;
  2740.     end;
  2741.    end else
  2742.    Begin
  2743.  
  2744.    end;
  2745.   end;
  2746.   Procedure DrawScreenZ;
  2747.    Var Fr,Bk,Pt,Tic:tGLPoint;
  2748.        FRP,BKP,PTP,TicP:TPoint;
  2749.        ZVal:Double;
  2750.       OldStyle: tBrushStyle;
  2751.       OldColor:tColor;
  2752.   Begin
  2753.    GetFrontBackPoints(XStart,YStart,fViewer.screenZ,10,Pt,Bk,Fr,Tic);
  2754.    If fGDIGeneric then
  2755.    Begin
  2756.     With fCanvas do
  2757.     Begin
  2758.       ProjectOnScreen(Fr,FRP,ZVal);
  2759.       bk.X:=Fr.X;bk.Y:=Fr.Y;
  2760.       ProjectOnScreen(Bk,BKP,ZVal);
  2761.       ProjectOnScreen(Pt,PTP,ZVal);
  2762.       ProjectOnScreen(Tic,TicP,ZVal);
  2763.  
  2764.  
  2765.       oldStyle:=Brush.Style;
  2766.       OldColor:=pen.Color;
  2767.       Brush.Style:=bsClear;
  2768.       pen.Color:=clLime;
  2769.  
  2770.       MoveTo(FRP.X,FRP.Y);
  2771.       LineTo(BKP.X,BKP.Y);
  2772.       MoveTo(XStart,YStart);
  2773.       LineTo(PTP.X,PTP.Y+10);
  2774.  
  2775.       Brush.Style:=OldStyle;
  2776.       pen.Color:=OldColor;
  2777.     end;
  2778.    end else
  2779.    Begin
  2780.  
  2781.    end;
  2782.   end;
  2783.  
  2784. Begin
  2785.   If not fLButtonDown then exit;
  2786.   Case fMoveMode of
  2787.     mmLookAt,mmRotate,mmWalk,mmFly,mmslide: DrawRotate;
  2788.     mmTwist:DrawTwist;
  2789.     mmModifyScreenZ:DrawScreenZ;
  2790.   end;{Case}
  2791. end;
  2792. (*************************************************************)
  2793. procedure TCustomOpenGLWindow.PaintWindow(DC: HDC);
  2794. Begin
  2795.   If not fStartUpLoop then
  2796.     Begin
  2797.       ReSetView(True);// need to reset for some systems on the first paint
  2798.       fStartUpLoop:=True; //set flag for painetd once
  2799.     end;
  2800.   if fHRC=0 then
  2801.   Begin
  2802.           fRebuildNeeded:=True;
  2803.           fRePaintneeded:=True;
  2804.           fValidBuffer:=False;
  2805.           GDIPaintWindow(DC);
  2806.   end else
  2807.   Begin
  2808.         Try
  2809.           GLLock;
  2810.           // lock this procedure
  2811.           EnableGL;
  2812.           // activeate the Render Context if needed
  2813.           fOldMask:=MaskX86Exceptions;
  2814.           // mask for divide by zero exceptions
  2815.           GLRenderWindow(True);
  2816.           //Render the view
  2817.         Finally
  2818.         //replace divide by zero mask
  2819.           RestoreX86Mask(fOldMask);
  2820.         // unlock the GL session
  2821.           GLUnLock;
  2822.         // check for GLErrors
  2823.           GetError;
  2824.         // handle all the GDI paint stuff
  2825.           GDIPaintWindow(DC);
  2826.         end;
  2827.   end;
  2828. end;
  2829. (*************************************************************)
  2830. (*
  2831. Procedure  TCustomOpenGLWindow.TextOut3D(anX,anY,anZ:glDouble;aSize:glFloat;aStr:String);
  2832.     // use the current base font to draw string
  2833. Begin
  2834.   If length(aStr)>255 then exit;
  2835.   glListBase(fDefaultTextID);
  2836.  
  2837.   glPushMatrix;
  2838.   glTranslatef(anX,anY,anZ);
  2839.   glScalef(aSize,aSize,aSize);
  2840.   glCallLists(length(aSTR),GL_Unsigned_Byte,@aStr[1]);
  2841.   glPopMatrix;
  2842.   glListBase(0);
  2843. end;
  2844. *)
  2845. (*************************************************************)
  2846. Procedure TCustomOpenGLWindow.DrawBorder;
  2847. Begin
  2848.   If Focused then
  2849.     CallList(fGeneralLists+dlFocusedBorder) ;
  2850.  (* else
  2851.     glCallList(fGeneralLists+dlUnFocusedBorder);*)
  2852. end;
  2853. {**********************************************************}
  2854.   Procedure TCustomOpenGLWindow.ConvertScreenToWorld(aLinkPt:TLinkPoint;UseFar:Boolean);
  2855.     var WP:tGLPoint;
  2856.         SP:TPoint;
  2857.         TB:Boolean;
  2858.    Begin
  2859.      If not assigned(aLinkPt) then exit;
  2860.      SP.X:=aLinkPt.SX;
  2861.      SP.Y:=aLinkPt.SY;
  2862.      If not useFar then
  2863.      TB:=GetFromScreen(WP,SP,aLinkPt.ScreenZ)
  2864.      else
  2865.      TB:=GetFromScreen(WP,SP,1);
  2866.      If TB then
  2867.       Begin
  2868.        aLinkPt.X:=WP.X;
  2869.        aLinkPt.Y:=WP.Y;
  2870.        aLinkPt.Z:=WP.Z;
  2871.       end;
  2872.    end;
  2873. {**********************************************************}
  2874.   Procedure TCustomOpenGLWindow.ConvertWorldToScreen(aLinkPt:TLinkPoint);
  2875.     var WP:tGLPoint;
  2876.         SP:TPoint;
  2877.    Begin
  2878.      If not assigned(aLinkPt) then exit;
  2879.      WP.X:=aLinkPt.X;
  2880.      WP.Y:=aLinkPt.Y;
  2881.      WP.Z:=aLinkPt.Z;
  2882.      aLinkPt.fScreenPtValid:=ProjectOnScreen(WP,SP,aLinkPt.ScreenZ);
  2883.      If aLinkPt.fScreenPtValid then
  2884.       begin
  2885.        aLinkPt.SX:=SP.x;
  2886.        aLinkPt.SY:=SP.Y;
  2887.        aLinkPt.SPt.X:=SP.X;
  2888.        aLinkPt.SPt.Y:=height-SP.Y;
  2889.       end;
  2890.    end;
  2891. (*************************************************************)
  2892. Procedure TCustomOpenGLWindow.UpdateScreenPos;
  2893.     //will update all the LinkPoint screen positions
  2894. Var I:LongInt;
  2895.     P1,P2:tGLPoint;
  2896.     S1,S2:tPoint;
  2897.     testDist:Integer;
  2898.     calcdist:Double;
  2899.     w,h:Longint;
  2900.  Begin
  2901.   EnableGL;
  2902.  
  2903.   ConvertWorldToScreen(fStartPos);
  2904.   ConvertWorldToScreen(fLastPos);
  2905.   ConvertWorldToScreen(fCurrentPos);
  2906.  
  2907.   For i:=0 to fSelectPoints.Count-1 do
  2908.       ConvertWorldToScreen(tLinkPoint(fSelectPoints.Items[I]));
  2909.   For i:=0 to fMovePoints.Count-1 do
  2910.       ConvertWorldToScreen(tLinkPoint(fMovePoints.Items[I]));
  2911.  
  2912. //Set the fGLPerPixel value, use the centre value 0.5
  2913.    TestDist:=1000;
  2914.    If fDrawToOther then
  2915.      Begin
  2916.       w:=fOtherWidth;h:=fOtherHeight;
  2917.      end else
  2918.      Begin
  2919.       w:=Width;h:=Height;
  2920.      end;
  2921.    With s1 do begin X:=w div 2;y:=h div 2;end;
  2922.    With s2 do begin X:=(w div 2)+Testdist;y:=h div 2;end;
  2923.    If GetFromScreen(P1,S1,0.5) and GetFromScreen(P2,S2,0.5) then
  2924.      Begin
  2925.       CalcDist:= sqrt(sqr(P1.X-P2.X)+ sqr(P1.Y-P2.Y)+sqr(P1.Z-P2.Z));
  2926.       fGLperPixel:=CalcDist/TestDist;
  2927.      end;
  2928.   // check for GLErrors
  2929.   GetError;
  2930. end;
  2931. (***********************************************)
  2932.  Procedure TCustomOpenGLWindow.Clear3DCursor;
  2933.   Begin
  2934.     fZLineSet:=False;
  2935.     fYLineSet:=False;
  2936.     fXLineSet:=False;
  2937.     fZLStart.X:=0;fZLStart.Y:=0;
  2938.     fZLend.X:=0;fZLend.Y:=0;
  2939.     fyLStart.X:=0;fyLStart.Y:=0;
  2940.     fyLend.X:=0;fyLend.Y:=0;
  2941.     fxLStart.X:=0;fxLStart.Y:=0;
  2942.     fxLend.X:=0;fxLend.Y:=0;
  2943.   end;
  2944. (***********************************************)
  2945.  Procedure TCustomOpenGLWindow.Draw3DGDICursor(aGridType:GLGridType);
  2946.     // draw the CAD style cross hairs
  2947.    Var X1,X2,Y1,Y2,Z1,Z2,fmin,fmax:tGLPoint;
  2948.       OldMode:TPenMode;
  2949.       oldStyle:TPenStyle;
  2950.       oldColor:TColor;
  2951.       oldBStyle:tBrushStyle;
  2952.       RefVal:GLDouble;
  2953.  
  2954.  Begin
  2955.    If not f3DCursorOn then exit;
  2956.    If (fMoveMode<>mmNone) and (ssLeft in fShift) then exit;
  2957.  
  2958.    With Canvas do
  2959.     Begin
  2960.     OldMode:= Pen.Mode;
  2961.     Pen.Mode:=pmXOr ;
  2962.     OldColor:=Pen.Color;
  2963.     Pen.Color:=clWhite;
  2964.     oldBStyle:=Brush.Style;
  2965.     oldStyle:=Pen.Style;
  2966.     Brush.Style:=bsClear;
  2967.  
  2968.     fMin:=Viewer.MinViewPrism(Grid_Scale);
  2969.     fMax:=Viewer.MaxViewPrism(Grid_Scale);
  2970.  //Z line
  2971.    Case aGridType of
  2972.     gtBottom,gtTop:
  2973.      Begin
  2974.        RefVal:=fHome.Z;
  2975.        Z1.X:=fCurrentPos.X;Z1.Y:=fCurrentPos.Y;Z1.Z:=RefVal;
  2976.        Z2.X:=fCurrentPos.X;Z2.Y:=fCurrentPos.Y;Z2.Z:=fCurrentPos.Z;
  2977.        Y1.X:=fmin.X;Y1.Y:=fCurrentPos.Y;Y1.Z:=RefVal;
  2978.        Y2.X:=fmax.X;Y2.Y:=fCurrentPos.Y;Y2.Z:=RefVal;
  2979.        X1.X:=fCurrentPos.X;X1.Y:=fmin.Y;X1.Z:=RefVal;
  2980.        X2.X:=fCurrentPos.X;X2.Y:=fmax.Y;X2.Z:=RefVal;
  2981.      end;
  2982.     gtLeftSide,gtRightSide:
  2983.      Begin
  2984.        RefVal:=fHome.X;
  2985.        Z1.X:=RefVal;Z1.Y:=fCurrentPos.Y;Z1.Z:=fCurrentPos.Z;
  2986.        Z2.X:=fCurrentPos.X;Z2.Y:=fCurrentPos.Y;Z2.Z:=fCurrentPos.Z;
  2987.        Y1.X:=RefVal;Y1.Y:=fCurrentPos.Y;Y1.Z:=fmin.Z;
  2988.        Y2.X:=RefVal;Y2.Y:=fCurrentPos.Y;Y2.Z:=fmax.Z;
  2989.        X1.X:=RefVal;X1.Y:=fmin.Y;X1.Z:=fCurrentPos.z;
  2990.        X2.X:=RefVal;X2.Y:=fmax.Y;X2.Z:=fCurrentPos.Z;
  2991.      end;
  2992.     gtBack,gtFront:
  2993.      Begin
  2994.        RefVal:=fHome.Y;
  2995.        Z1.X:=fCurrentPos.X;Z1.Y:=RefVal;Z1.Z:=fCurrentPos.Z;
  2996.        Z2.X:=fCurrentPos.X;Z2.Y:=fCurrentPos.Y;Z2.Z:=fCurrentPos.Z;
  2997.        Y1.X:=fmin.X;Y1.Y:=RefVal;Y1.Z:=fCurrentPos.Z;
  2998.        Y2.X:=fmax.X;Y2.Y:=RefVal;Y2.Z:=fCurrentPos.Z;
  2999.        X1.X:=fCurrentPos.X;X1.Y:=RefVal;X1.Z:=fmin.Z;
  3000.        X2.X:=fCurrentPos.X;X2.Y:=RefVal;X2.Z:=fmax.Z;
  3001.      end;
  3002.     end;{Case}
  3003.      If fZLineSet then
  3004.       Begin
  3005.        MoveTo(fZLStart.X,fZLStart.Y);
  3006.        LineTo(fZLEnd.X,fZLEnd.Y);
  3007.       end;
  3008.      If ProjectLineOnScreen(Z1,Z2) then
  3009.       Begin
  3010.            fZLStart.X:=Trunc(Z1.x);fZLStart.Y:=height-Trunc(Z1.Y);
  3011.            fZLend.X:=Trunc(Z2.x);fZLend.Y:=height-Trunc(Z2.Y);
  3012.            MoveTo(fZLStart.X,fZLStart.Y);LineTo(fZLEnd.X,fZLEnd.Y);
  3013.            fZLineSet:=True;
  3014.       end else fZLineSet:=False;
  3015.   //X line
  3016.  
  3017.      If fXLineSet then
  3018.       Begin
  3019.        MoveTo(fXLStart.X,fXLStart.Y);
  3020.        LineTo(fXLEnd.X,  fXLEnd.Y);
  3021.       end;
  3022.      If ProjectLineOnScreen(X1,X2) then
  3023.       Begin
  3024.            fXLStart.X:=Trunc(X1.x);fXLStart.Y:=height-Trunc(X1.Y);
  3025.            fXLend.X:=Trunc(X2.x);fXLend.Y:=height-Trunc(X2.Y);
  3026.            MoveTo(fXLStart.X,fXLStart.Y);LineTo(fXLEnd.X,  fXLEnd.Y);
  3027.            fXLineSet:=True;
  3028.       end else fXLineSet:=False;
  3029.   //Y line
  3030.  
  3031.      If fYLineSet then
  3032.       Begin
  3033.        MoveTo(fYLStart.X,fYLStart.Y);
  3034.        LineTo(fYLEnd.X,  fYLEnd.Y);
  3035.       end;
  3036.      If ProjectLineOnScreen(Y1,Y2) then
  3037.       Begin
  3038.            fYLStart.X:=Trunc(Y1.x);fYLStart.Y:=height-Trunc(Y1.Y);
  3039.            fYLend.X:=Trunc(Y2.x);fYLend.Y:=height-Trunc(Y2.Y);
  3040.            MoveTo(fYLStart.X,fYLStart.Y);LineTo(fYLEnd.X,  fYLEnd.Y);
  3041.            fYLineSet:=True;
  3042.       end else fYLineSet:=False;
  3043.  
  3044.     Pen.Mode:=OldMode;
  3045.     Pen.Style:=oldStyle;
  3046.     Brush.Style:=oldBStyle;
  3047.     Pen.Color:=OldColor;
  3048.     end;
  3049.  end;
  3050. (***********************************************)
  3051.  Procedure TCustomOpenGLWindow.Draw3DCursor(aGridType:GLGridType);
  3052.     // draw the CAD style cross hairs
  3053.    Var X1,X2,Y1,Y2,Z1,Z2,fmin,fmax:tGLPoint;
  3054.        RefVal:GLDouble;
  3055.  
  3056.  Begin
  3057.    If not f3DCursorOn then exit;
  3058.    If fGDIGeneric then exit;
  3059.    If (fMoveMode<>mmNone) and (ssLeft in fShift) then exit;
  3060.  
  3061.   fMin:=Viewer.MinViewPrism(Grid_Scale);
  3062.   fMax:=Viewer.MaxViewPrism(Grid_Scale);
  3063.  
  3064.    With GLCanvas do
  3065.     Begin
  3066.  
  3067.  //Z line
  3068.    Case aGridType of
  3069.     gtBottom,gtTop:
  3070.      Begin
  3071.        RefVal:=fHome.Z;
  3072.        Z1.X:=fCurrentPos.X;Z1.Y:=fCurrentPos.Y;Z1.Z:=RefVal;
  3073.        Z2.X:=fCurrentPos.X;Z2.Y:=fCurrentPos.Y;Z2.Z:=fCurrentPos.Z;
  3074.        Y1.X:=fmin.X;Y1.Y:=fCurrentPos.Y;Y1.Z:=RefVal;
  3075.        Y2.X:=fmax.X;Y2.Y:=fCurrentPos.Y;Y2.Z:=RefVal;
  3076.        X1.X:=fCurrentPos.X;X1.Y:=fmin.Y;X1.Z:=RefVal;
  3077.        X2.X:=fCurrentPos.X;X2.Y:=fmax.Y;X2.Z:=RefVal;
  3078.      end;
  3079.     gtLeftSide,gtRightSide:
  3080.      Begin
  3081.        RefVal:=fHome.X;
  3082.        Z1.X:=RefVal;Z1.Y:=fCurrentPos.Y;Z1.Z:=fCurrentPos.Z;
  3083.        Z2.X:=fCurrentPos.X;Z2.Y:=fCurrentPos.Y;Z2.Z:=fCurrentPos.Z;
  3084.        Y1.X:=RefVal;Y1.Y:=fCurrentPos.Y;Y1.Z:=fmin.Z;
  3085.        Y2.X:=RefVal;Y2.Y:=fCurrentPos.Y;Y2.Z:=fmax.Z;
  3086.        X1.X:=RefVal;X1.Y:=fmin.Y;X1.Z:=fCurrentPos.z;
  3087.        X2.X:=RefVal;X2.Y:=fmax.Y;X2.Z:=fCurrentPos.Z;
  3088.      end;
  3089.     gtBack,gtFront:
  3090.      Begin
  3091.        RefVal:=fHome.Y;
  3092.        Z1.X:=fCurrentPos.X;Z1.Y:=RefVal;Z1.Z:=fCurrentPos.Z;
  3093.        Z2.X:=fCurrentPos.X;Z2.Y:=fCurrentPos.Y;Z2.Z:=fCurrentPos.Z;
  3094.        Y1.X:=fmin.X;Y1.Y:=RefVal;Y1.Z:=fCurrentPos.Z;
  3095.        Y2.X:=fmax.X;Y2.Y:=RefVal;Y2.Z:=fCurrentPos.Z;
  3096.        X1.X:=fCurrentPos.X;X1.Y:=RefVal;X1.Z:=fmin.Z;
  3097.        X2.X:=fCurrentPos.X;X2.Y:=RefVal;X2.Z:=fmax.Z;
  3098.      end;
  3099.     end;{Case}
  3100.   //Z Line
  3101.  
  3102.     MoveTo(Z1);
  3103.     LineTo(Z2);
  3104.   //X line
  3105.     MoveTo(X1);
  3106.     LineTo(X2);
  3107.   //Y line
  3108.     MoveTo(Y1);
  3109.     LineTo(Y2);
  3110.   end;
  3111.  end;
  3112. (***********************************************)
  3113.  Procedure TCustomOpenGLWindow.GetViewPortGrid(aGridType:GLGridType;aStep:LongInt);
  3114.      var Linestart,LineEnd,fMin,fMax :tGLPoint;
  3115.          aRect:tRect;
  3116.          StartValX,StartValY,StartValZ,IncX,IncY,IncZ:Double;
  3117.          NoIncX,NoIncY,NoIncZ,Step:Smallint;
  3118.          CRM  : GLint;
  3119.          i:Longint;
  3120. // manage the feedback buffer data
  3121.  
  3122.  
  3123.      Procedure MakeLine(aVal:Double);
  3124.        var P1,P2:PGLPoint;
  3125.      Begin
  3126.           GetMem(P1,SizeOf(tGLPoint));
  3127.           P1^:=LineStart;
  3128.           GetMem(P2,SizeOf(tGLPoint));
  3129.           P2^:=LineEnd;
  3130.           If ProjectLineOnScreen(P1^,P2^) then
  3131.            Begin
  3132.             P1^.Z:=aVal;
  3133.             P2^.Z:=aVal;
  3134.             fGridPointsList.add(p1);
  3135.             fGridPointsList.add(p2);
  3136.            end else
  3137.            Begin
  3138.              FreeMem(P1,SizeOf(tGLPoint));
  3139.              FreeMem(P2,SizeOf(tGLPoint));
  3140.            end;
  3141.      end;
  3142.  
  3143.      Procedure BottomTop(CommonVal:Double);
  3144.         Var Count:LongInt;
  3145.         Begin
  3146.           SetGLPointVal(LineStart,StartValX,StartValY,CommonVal);
  3147.           SetGLPointVal(LineEnd,StartValX,StartValY+(IncY*NoIncY),CommonVal);
  3148.               For Count:=0 to NoIncX do
  3149.                Begin
  3150.                 MakeLine(LineStart.X);
  3151.                 LineStart.X:=LineStart.X+IncX;
  3152.                 LineEnd.X  :=LineEnd.X+incX;
  3153.                end;
  3154.            //2nd series vary Y horizontal lines
  3155.           SetGLPointVal(LineStart,StartValX,StartValY,CommonVal);
  3156.           SetGLPointVal(LineEnd,StartValX+(IncX*NoIncX),StartValY,CommonVal);
  3157.            For Count:=0 to NoIncY do
  3158.                Begin
  3159.                 MakeLine(LineStart.Y);
  3160.                 LineStart.Y:=LineStart.Y+IncY;
  3161.                 LineEnd.Y:=LineEnd.Y+incY;
  3162.                end;
  3163.        end;
  3164.  
  3165.      Procedure LeftRight(CommonVal:Double);
  3166.       // pass in constant x
  3167.         Var Count:LongInt;
  3168.         Begin
  3169.           SetGLPointVal(LineStart,CommonVal,StartValY,StartValZ);
  3170.           SetGLPointVal(LineEnd,CommonVal,StartValY+(IncY*NoIncY),StartValZ);
  3171.               For Count:=0 to NoIncZ do
  3172.                Begin
  3173.                 MakeLine(LineStart.Z);
  3174.                 LineStart.Z:=LineStart.Z+IncZ;
  3175.                 LineEnd.Z:=LineEnd.Z+incZ;
  3176.                end;
  3177.            //2nd series vary Y horizontal lines
  3178.           SetGLPointVal(LineStart,CommonVal,StartValY,StartValZ);
  3179.           SetGLPointVal(LineEnd,CommonVal,StartValY,StartValZ+(IncZ*NoIncZ));
  3180.            For Count:=0 to NoIncY do
  3181.                Begin
  3182.                 MakeLine(LineStart.Y);
  3183.                 LineStart.Y:=LineStart.Y+IncY;
  3184.                 LineEnd.Y:=LineEnd.Y+incY;
  3185.                end;
  3186.        end;
  3187.      Procedure FrontBack(CommonVal:Double);
  3188.       // pass in constant Y
  3189.         Var Count:LongInt;
  3190.         Begin
  3191.            //first series Vertical lines Vary Z
  3192.           SetGLPointVal(LineStart,StartValX,CommonVal,StartValZ);
  3193.           SetGLPointVal(LineEnd,StartValX+(IncX*NoIncX),CommonVal,StartValZ);
  3194.               For Count:=0 to NoIncZ do
  3195.                Begin
  3196.                 MakeLine(LineStart.Z);
  3197.                 LineStart.Z:=LineStart.Z+IncZ;
  3198.                 LineEnd.Z  :=LineEnd.Z  +incZ;
  3199.                end;
  3200.            //2nd series vary X horizontal lines
  3201.           SetGLPointVal(LineStart,StartValX,CommonVal,StartValZ);
  3202.           SetGLPointVal(LineEnd,StartValX,CommonVal,StartValZ+(IncZ*NoIncZ));
  3203.            For Count:=0 to NoIncX do
  3204.                Begin
  3205.                 MakeLine(LineStart.X);
  3206.                 LineStart.X:=LineStart.X+IncX;
  3207.                 LineEnd.X  :=LineEnd.X  +incX;
  3208.                end;
  3209.        end;
  3210.  
  3211.   Begin
  3212.  
  3213.      glGetIntegerv(GL_RENDER_MODE,@CRM);
  3214. // if not in the right mode then quit
  3215.      If CRM<>GL_RENDER then exit;
  3216.  
  3217.   {If perspective then exit;}
  3218.    If Not fDrawToOther then
  3219.     Begin
  3220.           With aRect do
  3221.           Begin
  3222.              Left:=0;Top:=0;Right:=width; Bottom:=height;
  3223.           end;
  3224.     end else
  3225.     Begin
  3226.           With aRect do
  3227.           Begin
  3228.              Left:=0;Top:=0;Right:=fOtherWidth;Bottom:=fOtherHeight;
  3229.           end;
  3230.     end;
  3231.  //clear the last list
  3232.     For i:=0 to fGridPointsList.count-1 do
  3233.         FreeMem(fGridPointsList.Items[i],SizeOf(tGLPoint));
  3234.     fGridPointsList.Clear;
  3235.     If astep<=0 then step:=8 else step:=aStep;
  3236.  
  3237.     fMin:=Viewer.MinViewPrism(Grid_Scale);
  3238.     fMax:=Viewer.MaxViewPrism(Grid_Scale);
  3239.      //first series Vertical lines Vary X
  3240.     Scale_Data(fMin.X,fMax.X,Step,StartValX,IncX,NoIncX);
  3241.      //first series Vertical lines Vary Y
  3242.     Scale_Data(fMin.Y,fMax.Y,Step,StartValY,IncY,NoIncY);
  3243.      //first series Vertical lines Vary Y
  3244.     Scale_Data(fMin.Z,fMax.Z,Step,StartValZ,IncZ,NoIncZ);
  3245. // get the final clipped data
  3246.  
  3247.     If Perspective then
  3248.      Begin
  3249.         //Use the centre for the grid values
  3250.         Case aGridtype of
  3251.            gtBottom,gtTop        :  BottomTop(fHome.Z);
  3252.            gtLeftSide,gtRightSide:  LeftRight(fHome.X);
  3253.            gtBack,gtFront        :  FrontBack(fHome.Y);
  3254.         end;
  3255.      end else
  3256.      Begin
  3257.         Case aGridtype of
  3258.            gtBottom,gtTop        :  BottomTop(fMin.Z);
  3259.            gtLeftSide,gtRightSide:  LeftRight(fMin.X);
  3260.            gtBack,gtFront        :  FrontBack(fMin.Y);
  3261.         end;
  3262.      end;
  3263.    end;
  3264. (***********************************************)
  3265.  Procedure TCustomOpenGLWindow.DrawViewPortGrid(IncText:Boolean);
  3266.   Var i:LongInt;
  3267.       p1,P2:tGLPoint;
  3268.       aVal:Double;
  3269.       s:String;
  3270.   Begin
  3271.     If fGridPointsList.Count=0 then exit;
  3272.     glCanvas.LineWidth:=1;
  3273.     glCanvas.Color:=glGray60;
  3274.     glCanvas.LineStyle:=stDotted4;
  3275.     i:=0;
  3276.     Repeat
  3277.        P1:= pGLPoint(fGridPointsList.Items[i])^;
  3278.        P2:= pGLPoint(fGridPointsList.Items[i+1])^;
  3279.        aVal:=P1.Z;
  3280.        P1.Z:=0;P2.Z:=0;
  3281.        glCanvas.MoveTo(P1);
  3282.        glCanvas.LineTo(P2);
  3283.        Str(aVal:-1:0,s);
  3284.        If IncText then
  3285.          Begin
  3286.           If P1.Y>p2.Y then
  3287.            Begin
  3288.             P2.Y:=P2.Y+5;
  3289.             P2.X:=P2.X+5;
  3290.             glCanvas.TextOut2D(P2,1,s);
  3291.            end else
  3292.            Begin
  3293.             P1.Y:=P1.Y+5;
  3294.             P1.X:=P1.X+5;
  3295.             glCanvas.TextOut2D(P1,1,s);
  3296.            end;
  3297.           end;
  3298.        P1.Z:=aVal;P2.Z:=aVal;
  3299.        i:=i+2;
  3300.     until i>= fGridPointsList.Count-1;
  3301.     glCanvas.Color:=glBlack;
  3302.     glCanvas.LineStyle:=stContinous;
  3303.   end;
  3304.  
  3305. (*************************************************************)
  3306. Procedure TCustomOpenGLWindow.DrawSimpleAxis;
  3307.     //draw a simple X,Y,Z axis
  3308.       Var setpoint,StartPoint,endPoint1,endpoint2,endpoint3:tGLPoint;
  3309.           aPt:tPoint;
  3310.           aSizeMult,pixval:Single;
  3311.     Begin
  3312.       If not fSimpleAxis {or perspective} then exit;
  3313. // set up for the L state in display list
  3314.       glCanvas.LineWidth:=1;
  3315.       aPt.X:=50;
  3316.       aPt.Y:=50;
  3317.       pixval:=UnitsPerPixel/2;
  3318.       GetFromScreen(setpoint,aPt,0.5);
  3319.       aSizeMult:=50*pixval;
  3320.       glLineWidth(1.0);
  3321.       glDisable(GL_DEPTH_TEST);
  3322.       glDisable(GL_LINE_SMOOTH);
  3323.       {glScalef(UnitsPerPixel,UnitsPerPixel,UnitsPerPixel);}
  3324.       glTranslatef(setpoint.X,setpoint.Y,setpoint.Z);
  3325.       startPoint.X:=0;startPoint.Y:=0;startPoint.Z:=0;
  3326.       endpoint1.X:=aSizeMult;endpoint1.Y:=0;endpoint1.Z:=0;
  3327.       endpoint2.X:=0;endpoint2.Y:=aSizeMult;endpoint2.Z:=0;
  3328.       endpoint3.X:=0;endpoint3.Y:=0;endpoint3.Z:=aSizeMult;
  3329.       glBegin(GL_LINES);
  3330.         glColor4fv(@glRed);
  3331.         glVertex3dv(@startpoint);
  3332.         glVertex3dv(@endpoint1);
  3333.         glVertex3d(55*pixval,13*pixval,0);
  3334.         glVertex3d(55*pixval,-13*pixval,0);
  3335.         glVertex3d(55*pixval,13*pixval,0);
  3336.         glVertex3d(80*pixval,13*pixval,0);
  3337.         glVertex3d(55*pixval,-13*pixval,0);
  3338.         glVertex3d(80*pixval,-13*pixval,0);
  3339.         glVertex3d(55*pixval,0,0);
  3340.         glVertex3d(75*pixval,0,0);
  3341.         glColor4fv(@glBlue);
  3342.         glVertex3dv(@startpoint);
  3343.         glVertex3dv(@endpoint2);
  3344.         glVertex3d(-13*pixval,55*pixval,0);
  3345.         glVertex3d(-13*pixval,80*pixval,0);
  3346.         glVertex3d(-13*pixval,80*pixval,0);
  3347.         glVertex3d(13*pixval,55*pixval,0);
  3348.         glVertex3d(13*pixval,55*pixval,0);
  3349.         glVertex3d(13*pixval,80*pixval,0);
  3350.         glColor4fv(@glGreen);
  3351.         glVertex3dv(@startpoint);
  3352.         glVertex3dv(@endpoint3);
  3353.       glend;
  3354.  
  3355.  
  3356.     end;
  3357. (*************************************************************)
  3358. Procedure TCustomOpenGLWindow.DrawSelectedPoints;
  3359.     //Draw the selected points according to current draw mode}
  3360. Var I:LongInt;
  3361.     aPt:tLinkPoint;
  3362. Begin
  3363.   {If fViewAnimation then exit;}
  3364.  { If  or (fToolMode=tlNone) then exit;}
  3365.     //Set up draw mode
  3366.   saveState(stDrawing);
  3367.   If (fSelectPoints.Count>0) then
  3368.    Begin
  3369.       glLineWidth(1.0);
  3370.       glLineStipple(3, stDotted1);
  3371.       glColor4fv(@glBlack);
  3372.       glPointSize(2);
  3373.       Case fToolMode of
  3374.         tlPoint:glBegin(GL_Points);
  3375.         tlLine:glBegin(GL_LINES);
  3376.         tlPolyLine:glBegin(GL_LINE_STRIP);
  3377.         tlPolygon:glBegin(GL_LINE_LOOP);
  3378.       end;
  3379.       //Loop through points and draw
  3380.       If fToolMode<>tlRectangle then
  3381.       Begin
  3382.         For i:=0 to fSelectPoints.Count-1 do
  3383.         Begin
  3384.           aPt:=tLinkPoint(fSelectPoints.Items[I]);
  3385.           glVertex3dv(aPt.GetWorldPt);
  3386.         end;
  3387.         glEnd;
  3388.       end;
  3389.    end;
  3390.   IF (fMoveMode=mmMeasure) and (fMovePoints.Count>0) then
  3391.       Begin
  3392.      {dRAW  THE MEASURE LINES}
  3393.           glLineWidth(1.0);
  3394.           glLineStipple(3, stDotted1);
  3395.           glColor4fv(@glLime);
  3396.           glBegin(GL_LINE_LOOP);
  3397.           //Loop through points and draw
  3398.           For i:=0 to fMovePoints.Count-1 do
  3399.             Begin
  3400.               aPt:=tLinkPoint(fMovePoints.Items[I]);
  3401.               glVertex3dv(aPt.GetWorldPt);
  3402.             end;
  3403.           glEnd;
  3404.       end;
  3405.   RestoreState;
  3406. end;
  3407. (*************************************************************)
  3408. Function TCustomOpenGLWindow.GetGLVendor:pchar;
  3409. Begin
  3410.   Result:=GetGLStringValue(GL_Vendor);
  3411. end;
  3412. (*************************************************************)
  3413. Function TCustomOpenGLWindow.GetGLRenderer:pchar;
  3414. Begin
  3415.   Result:=GetGLStringValue(GL_RENDERER);
  3416. end;
  3417. (*************************************************************)
  3418. Function TCustomOpenGLWindow.GetGLVersion:pchar;
  3419. Begin
  3420.   Result:=GetGLStringValue(GL_VERSION);
  3421. end;
  3422. (*************************************************************)
  3423. Function TCustomOpenGLWindow.GetGLExtensions:pchar;
  3424. Begin
  3425.   Result:=GetGLStringValue(GL_EXTENSIONS);
  3426. end;
  3427. (*************************************************************)
  3428. function TCustomOpenGLWindow.GetPalette: HPALETTE;
  3429. Begin
  3430.   Result:=fGLPalette;
  3431. end;
  3432. (*************************************************************)
  3433. Procedure TCustomOpenGLWindow.SetMode(aMode:GLMoveMode);
  3434. Begin
  3435.   If fMoveMode=aMode then exit;
  3436.   fMoveMode:=aMode;
  3437.   Repaint;
  3438. end;
  3439. (**************************************************************)
  3440. Procedure TCustomOpenGLWindow.Clearscreen;
  3441.     //clear all the glbuffers
  3442. Begin
  3443.   glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT );
  3444. end;
  3445. (**************************************************************)
  3446. Procedure TCustomOpenGLWindow.UpdateScreenDisplayLists;
  3447. //call when screen size change
  3448.  
  3449.   const
  3450.    EdgeOff=0;
  3451.   var w,h:Longint;
  3452.   Begin
  3453.   if fGeneralLists=0 then exit;
  3454.   If not EnableGL then exit;;
  3455.   glListBase(0);
  3456.  
  3457.   If not fDrawToOther then
  3458.    Begin
  3459.      w:=width;
  3460.      h:=height;
  3461.    end else
  3462.    Begin
  3463.      w:=fOtherWidth;
  3464.      h:=fOtherHeight;
  3465.    end;
  3466.  
  3467.   glNewList(fGeneralLists+dl2DWindow,GL_Compile);
  3468.     glMatrixMode(GL_PROJECTION);
  3469.     glPushMatrix;
  3470.     glLoadIdentity;
  3471.     gluOrtho2D(-w/2,w/2,-h/2,h/2);
  3472.     glMatrixMode(GL_MODELVIEW);
  3473.     // do the render stuff
  3474.     glPushMatrix();
  3475.     glLoadIdentity;
  3476.     glTranslatef(-w/2,-h/2,1);
  3477.   glEndList;
  3478.  
  3479.   glNewList(fGeneralLists+dlFocusedBorder,GL_Compile);
  3480.     saveState(stDrawing);
  3481.     {glCallList(fGeneralLists+dl2DWindow);}
  3482.     glColor4fv(@glBlack);
  3483.     glDisable(GL_BLEND);
  3484.     glDisable(GL_LINE_Stipple);
  3485.     glEnable(GL_LINE_SMOOTH);
  3486.     glDisable(GL_Depth_Test);
  3487.     glLineWidth(1.0);
  3488.     glBegin(GL_LINE_STRIP);
  3489.       glVertex2f(EdgeOff,EdgeOff);
  3490.       glVertex2f(w-EdgeOff-2,EdgeOff);
  3491.       glVertex2f(w-EdgeOff-2,h-EdgeOff-2);
  3492.       glVertex2f(EdgeOff,h-EdgeOff-2);
  3493.       glVertex2f(EdgeOff,EdgeOff);
  3494.     glEnd;
  3495.     glPopMatrix();
  3496.       //tidy up
  3497.     glMatrixMode(GL_PROJECTION);
  3498.     glPopMatrix;
  3499.     glMatrixMode(GL_MODELVIEW);
  3500.     RestoreState;
  3501. glEndList;
  3502.  (*
  3503.   glNewList(fGeneralLists+dlUnFocusedBorder,GL_Compile);
  3504.     {glCallList(fGeneralLists+dl2DWindow);}
  3505.     saveState(stDrawing);
  3506.     glDisable(GL_BLEND);
  3507.     glDisable(GL_LINE_Stipple);
  3508.     glEnable(GL_LINE_SMOOTH);
  3509.     glDisable(GL_Depth_Test);
  3510.     glLineWidth(1.0);
  3511.     glColor4fv(@glDkGray);
  3512.  
  3513.     glBegin(GL_LINE_STRIP);
  3514.       glVertex2f(0,0);
  3515.       glVertex2f(w-0,0);
  3516.       glVertex2f(w-0,h-0);
  3517.       glVertex2f(0,h-0);
  3518.       glVertex2f(0,0);
  3519.     glEnd;
  3520.     glLineWidth(1.0);
  3521.     glPopMatrix();
  3522.     //tidy up
  3523.     glMatrixMode(GL_PROJECTION);
  3524.     glPopMatrix;
  3525.     glMatrixMode(GL_MODELVIEW);
  3526.     RestoreState;
  3527.  glEndList;
  3528.  *)
  3529.  glNewList(fGeneralLists+dlBackground,GL_COMPILE);
  3530.     glDisable(GL_BLEND);
  3531.     glDisable(GL_LINE_SMOOTH);
  3532.     glDisable(GL_POINT_SMOOTH);
  3533.     glDisable(GL_LINE_Stipple);
  3534.     glDisable(GL_DePTH_TEST);
  3535.     glShadeModel(GL_Flat);
  3536. glEndList;
  3537.  
  3538.  glNewList(fGeneralLists+dlForeGround,GL_COMPILE);
  3539.     glDisable(GL_BLEND);
  3540.     glDisable(GL_LINE_SMOOTH);
  3541.     glDisable(GL_POINT_SMOOTH);
  3542.     glDisable(GL_LINE_Stipple);
  3543.     glDisable(GL_DePTH_TEST);
  3544.     glShadeModel(GL_Flat);
  3545. glEndList;
  3546.   // check for GLErrors
  3547.      GetError;
  3548.  
  3549.  end;
  3550. (**************************************************************)
  3551. Procedure TCustomOpenGLWindow.BuildDisplayLists;
  3552. Const
  3553.   pi180:double=pi/180;
  3554. var
  3555.   Quad :GLUquadricObj;
  3556.   i    :LongInt;
  3557.   x,y,z:glDouble;
  3558. Begin
  3559.   if fGeneralLists=0 then exit;
  3560.   If assigned(fShareGL) or not fStdDisplayList then exit;
  3561.  
  3562.   If not EnableGL then exit;
  3563.   glListBase(0);
  3564.  
  3565.   glNewList(fGeneralLists+dlFullRenderMode,GL_COMPILE);
  3566.     glEnable(GL_LINE_SMOOTH);
  3567.     glEnable(GL_POINT_SMOOTH);
  3568.     glEnable(GL_LINE_Stipple);
  3569.     glEnable(GL_DePTH_TEST);
  3570.     glShadeModel(GL_Smooth);
  3571.   glEndList;
  3572.  
  3573.   glNewList(fGeneralLists+dlQuickRenderMode,GL_COMPILE);
  3574.     glEnable(GL_DePTH_TEST);
  3575.     glDisable(GL_LINE_SMOOTH);
  3576.     glDisable(GL_POINT_SMOOTH);
  3577.     glShadeModel(GL_Flat);
  3578.   glEndList;
  3579.  
  3580.  
  3581.   glNewList(fGeneralLists+dlFullAxis,GL_COMPILE);
  3582.     DrawAxes(1,0.2,0.5,AxisRes,true);
  3583.   glEndList;
  3584.  
  3585.   glNewList(fGeneralLists+dlQuickAxis,GL_COMPILE);
  3586.     DrawAxes(1,0.2,0.5,AxisRes,False);
  3587.   glEndList;
  3588.  
  3589.   BuildGrids;
  3590.  
  3591.   UpdateScreenDisplayLists;
  3592.  
  3593.   glNewList(fGeneralLists+dlPointCross,GL_COMPILE);
  3594.     saveState(stDrawing);
  3595.     glColor4fv(@glBlack);
  3596.     glBegin(gl_Lines);
  3597.       glvertex3f(-0.5,0,0);
  3598.       glvertex3f(0.5,0,0);
  3599.       glvertex3f(0,-0.5,0);
  3600.       glvertex3f(0,0.5,0);
  3601.       glvertex3f(0,0,-0.5);
  3602.       glvertex3f(0,0,0.5);
  3603.     glEnd;
  3604.     RestoreState;
  3605.   glEndList;
  3606.  
  3607.   glNewList(fGeneralLists+dlPointX,GL_COMPILE);
  3608.     saveState(stDrawing);
  3609.     glColor4fv(@glBlack);
  3610.     glBegin(gl_Lines);
  3611.       glvertex3f(-0.5,-0.5,-0.5);
  3612.       glvertex3f(0.5,0.5,0.5);
  3613.       glvertex3f(-0.5,0.5,-0.5);
  3614.       glvertex3f(0.5,-0.5,0.5);
  3615.       glvertex3f(-0.5,-0.5,0.5);
  3616.       glvertex3f(0.5,0.5,-0.5);
  3617.       glvertex3f(0.5,-0.5,-0.5);
  3618.       glvertex3f(-0.5,0.5,0.5);
  3619.     glEnd;
  3620.     RestoreState;
  3621.   glEndList;
  3622.  
  3623.   glNewList(fGeneralLists+dlPointsphere,GL_COMPILE);
  3624.     saveState(stDrawing);
  3625.     Quad:=gluNewQuadric;
  3626.     glColor4fv(@glRed);     {X Axis}
  3627.     gluSphere(Quad,0.5,10,10);
  3628.     gluDeleteQuadric(Quad);
  3629.     RestoreState;
  3630.   glEndList;
  3631.  
  3632.   glNewList(fGeneralLists+dlSimpleCube,GL_COMPILE);
  3633.     saveState(stDrawing);
  3634.     glBegin(gl_QUADS);
  3635.   //top
  3636.      glVertex3d(-0.5,-0.5, 0.5);
  3637.      glVertex3d(-0.5, 0.5, 0.5);
  3638.      glVertex3d( 0.5, 0.5, 0.5);
  3639.      glVertex3d( 0.5,-0.5, 0.5);
  3640.   //Right
  3641.      glVertex3d( 0.5,-0.5,-0.5);
  3642.      glVertex3d( 0.5,-0.5, 0.5);
  3643.      glVertex3d( 0.5, 0.5, 0.5);
  3644.      glVertex3d( 0.5, 0.5,-0.5);
  3645.   //Front
  3646.      glVertex3d(-0.5, 0.5,-0.5);
  3647.      glVertex3d(-0.5, 0.5, 0.5);
  3648.      glVertex3d( 0.5, 0.5, 0.5);
  3649.      glVertex3d( 0.5, 0.5,-0.5);
  3650.   //bottom
  3651.      glVertex3d( 0.5,-0.5, -0.5);
  3652.      glVertex3d( 0.5, 0.5, -0.5);
  3653.      glVertex3d(-0.5, 0.5, -0.5);
  3654.      glVertex3d(-0.5,-0.5, -0.5);
  3655.   //left
  3656.      glVertex3d(-0.5, 0.5,-0.5);
  3657.      glVertex3d(-0.5, 0.5, 0.5);
  3658.      glVertex3d(-0.5,-0.5, 0.5);
  3659.      glVertex3d(-0.5,-0.5,-0.5);
  3660.   //back
  3661.      glVertex3d( 0.5,-0.5,-0.5);
  3662.      glVertex3d( 0.5,-0.5, 0.5);
  3663.      glVertex3d(-0.5,-0.5, 0.5);
  3664.      glVertex3d(-0.5,-0.5,-0.5);
  3665.     glEnd;
  3666.     RestoreState;
  3667.   glEndList;
  3668.  
  3669.   glNewList(fGeneralLists+dlSelectCube,GL_COMPILE);
  3670.     glColor4fv(@glBlack);
  3671.     CallList(fGeneralLists+dlSimpleCube);
  3672.   glEndList;
  3673.  
  3674.   glNewList(fGeneralLists+dlLockedSelectCube,GL_COMPILE);
  3675.     glColor4fv(@glGray50);
  3676.     CallList(fGeneralLists+dlSimpleCube);
  3677.     saveState(stDrawing);
  3678.     glColor4fv(@glBlack);
  3679.     glLineWidth(2);
  3680.     glBegin(GL_LINES);
  3681.   //top
  3682.      glVertex3d(-0.5,-0.5, 0.5);
  3683.      glVertex3d(-0.5, 0.5, 0.5);
  3684.      glVertex3d( 0.5, 0.5, 0.5);
  3685.      glVertex3d( 0.5,-0.5, 0.5);
  3686.   //Right
  3687.      glVertex3d( 0.5,-0.5,-0.5);
  3688.      glVertex3d( 0.5,-0.5, 0.5);
  3689.      glVertex3d( 0.5, 0.5, 0.5);
  3690.      glVertex3d( 0.5, 0.5,-0.5);
  3691.   //Front
  3692.      glVertex3d(-0.5, 0.5,-0.5);
  3693.      glVertex3d(-0.5, 0.5, 0.5);
  3694.      glVertex3d( 0.5, 0.5, 0.5);
  3695.      glVertex3d( 0.5, 0.5,-0.5);
  3696.   //bottom
  3697.      glVertex3d( 0.5,-0.5, -0.5);
  3698.      glVertex3d( 0.5, 0.5, -0.5);
  3699.      glVertex3d(-0.5, 0.5, -0.5);
  3700.      glVertex3d(-0.5,-0.5, -0.5);
  3701.   //left
  3702.      glVertex3d(-0.5, 0.5,-0.5);
  3703.      glVertex3d(-0.5, 0.5, 0.5);
  3704.      glVertex3d(-0.5,-0.5, 0.5);
  3705.      glVertex3d(-0.5,-0.5,-0.5);
  3706.   //back
  3707.      glVertex3d( 0.5,-0.5,-0.5);
  3708.      glVertex3d( 0.5,-0.5, 0.5);
  3709.      glVertex3d(-0.5,-0.5, 0.5);
  3710.      glVertex3d(-0.5,-0.5,-0.5);
  3711.   //sides
  3712.      glVertex3d( 0.5,-0.5,-0.5);
  3713.      glVertex3d( -0.5,-0.5,-0.5);
  3714.      glVertex3d( 0.5,-0.5, 0.5);
  3715.      glVertex3d( -0.5,-0.5, 0.5);
  3716.      glVertex3d( 0.5, 0.5, 0.5);
  3717.      glVertex3d( -0.5, 0.5, 0.5);
  3718.      glVertex3d( 0.5, 0.5,-0.5);
  3719.      glVertex3d( -0.5, 0.5,-0.5);
  3720.     glend;
  3721.     RestoreState;
  3722.   glEndList;
  3723.  
  3724.   glNewList(fGeneralLists+dlSimpleDiamond,GL_COMPILE);
  3725.     saveState(stDrawing);
  3726. (*    glBegin(gl_QUADS);
  3727.   //top
  3728.      glVertex3d(-0.5,0, 0.5);
  3729.     glend;*)
  3730.     RestoreState;
  3731.   glEndList;
  3732.  
  3733.   glNewList(fGeneralLists+dlXYCircle,GL_COMPILE);
  3734.     saveState(stDrawing);
  3735.     z:=0;
  3736.     glBegin(GL_LINE_STRIP);
  3737.     For i:=0 to 360 do
  3738.       Begin
  3739.         x:=sin(i*pi180);
  3740.         y:=Cos(i*pi180);
  3741.         glVertex3f(x,y,z);
  3742.       end;
  3743.     glend;
  3744.     RestoreState;
  3745.   glEndList;
  3746.  
  3747.   glNewList(fGeneralLists+dlXZCircle,GL_COMPILE);
  3748.     saveState(stDrawing);
  3749.     y:=0;
  3750.     glBegin(GL_LINE_STRIP);
  3751.     For i:=0 to 360 do
  3752.       Begin
  3753.         x:=sin(i*pi180);
  3754.         z:=Cos(i*pi180);
  3755.         glVertex3f(x,y,z);
  3756.       end;
  3757.     glend;
  3758.     RestoreState;
  3759.   glEndList;
  3760.  
  3761.   glNewList(fGeneralLists+dlYZCircle,GL_COMPILE);
  3762.     saveState(stDrawing);
  3763.     x:=0;
  3764.     glBegin(GL_LINE_STRIP);
  3765.     For i:=0 to 360 do
  3766.       Begin
  3767.         z:=sin(i*pi180);
  3768.         y:=Cos(i*pi180);
  3769.         glVertex3f(x,y,z);
  3770.       end;
  3771.     glEnd;
  3772.     RestoreState;
  3773.   glEndList;
  3774.  
  3775.   BuildBitMapText('Arial',10);
  3776.   BuildOutLineFont('Arial');
  3777.  
  3778.   If Assigned(fOnBuildDisplayLists) then
  3779.    fOnBuildDisplayLists(Self,fRenderMode,glCanvas);
  3780.   // check for GLErrors
  3781.    GetError;
  3782.  
  3783. end;
  3784. (*************************************************************)
  3785. Procedure TCustomOpenGLWindow.BuildBitMapText(afontname:String;aSize:smallint);
  3786. Var  aLF          :TLogFont;
  3787.      afont,oldfont:HFont;
  3788. Begin
  3789.   If fRenderDC<>0 then FillChar(aLF,SizeOf(aLF),0);
  3790.   With aLF do
  3791.   Begin
  3792.     lfHeight:=-abs(aSize);
  3793.     lfOrientation:=lfEscapement;
  3794.     lfWeight:=FW_Normal;
  3795.     lfItalic:=0;
  3796.     lfUnderline:=0;
  3797.     lfStrikeOut:=0;
  3798.     lfCharSet:=ANSI_CHARSET;
  3799.     lfOutPrecision:=Out_TT_Precis;
  3800.     lfClipPrecision:=Clip_Default_Precis;
  3801.     lfQuality:=Default_Quality;
  3802.     lfPitchAndfamily:=DEFault_Pitch;
  3803.     If (length(aFontname)>0) and (Length(aFontname)<31) then
  3804.      strpcopy(@lfFacename,aFontname)
  3805.     else
  3806.      //default text
  3807.      lfFacename:='Arial';
  3808.   end;
  3809.   aFont:=CreateFontIndirect(aLF);
  3810.   If aFont<>0 then
  3811.    Begin
  3812.     OldFont:=SelectObject(fRenderDC,aFont);
  3813.     wglUseFontBitmaps(fRenderDC,0,255,fDefaultFlatTextID);
  3814.     SelectObject(fRenderDC,OldFont);
  3815.     DeleteObject(aFont);
  3816.    end;
  3817. end;
  3818. (******* ******************************************************)
  3819. Procedure TCustomOpenGLWindow.BuildOutLineFont(afontname:String);
  3820. Var  aLF:TLogFont;
  3821.      afont,oldfont:HFont;
  3822. Begin
  3823.   If fRenderDC<>0 then
  3824.     FillChar(aLF,SizeOf(aLF),0);
  3825.   With aLF do
  3826.   Begin
  3827.     lfHeight:=-12;
  3828.     lfOrientation:=lfEscapement;
  3829.     lfWeight:=FW_Normal;
  3830.     lfItalic:=0;
  3831.     lfUnderline:=0;
  3832.     lfStrikeOut:=0;
  3833.     lfCharSet:=ANSI_CHARSET;
  3834.     lfOutPrecision:=Out_TT_Precis;
  3835.     lfClipPrecision:=Clip_Default_Precis;
  3836.     lfQuality:=Default_Quality;
  3837.     lfPitchAndfamily:=DEFault_Pitch;
  3838.     If (length(aFontname)>0) and (Length(aFontname)<31) then
  3839.      strpcopy(@lfFacename,aFontname)
  3840.     else
  3841.      lfFacename:='Arial';
  3842.   end;
  3843.   aFont:=CreateFontIndirect(aLF);
  3844.   If aFont<>0 then
  3845.    Begin
  3846.     OldFont:=SelectObject(fRenderDC,aFont);
  3847.     wglUseFontOutLines(fRenderDC,0,255,fDefaultTextID,0.01,0.1,WGL_FONT_POLYGONS,@fGMF);
  3848.     SelectObject(fRenderDC,OldFont);
  3849.     DeleteObject(aFont);
  3850.    end;
  3851. end;
  3852. (******* ******************************************************)
  3853. Procedure TCustomOpenGLWindow.BuildGrids;
  3854.    //set up the basic grid components
  3855. var aPt1,apt2:tGLPoint;
  3856. Begin
  3857.   aPt1.X:=fhome.X-fViewer.XRadius;
  3858.   aPt1.Y:=fhome.Y-fViewer.YRadius;
  3859.   aPt1.Z:=fHome.Z-fViewer.ZRadius;
  3860.   aPt2.X:=fHome.X+fViewer.XRadius;
  3861.   aPt2.Y:=fHome.Y+fViewer.YRadius;
  3862.   aPt2.Z:=fHome.Z+fViewer.ZRadius;
  3863.  
  3864.   saveState(stDrawing);
  3865.   Try
  3866.       Try
  3867.       //glcallList(fGeneralLists+dlQuickRenderMode);
  3868.           glNewList(fGeneralLists+dlGridFront,GL_Compile);
  3869.             CreateGrid(aPt1,aPt2,gtFront,0);
  3870.           glEndList;
  3871.           glNewList(fGeneralLists+dlGridBack,GL_Compile);
  3872.             CreateGrid(aPt1,aPt2,gtBack,0);
  3873.           glEndList;
  3874.           glNewList(fGeneralLists+dlGridLeft,GL_Compile);
  3875.             CreateGrid(aPt1,aPt2,gtLeftSide,0);
  3876.           glEndList;
  3877.           glNewList(fGeneralLists+dlGridRight,GL_Compile);
  3878.             CreateGrid(aPt1,aPt2,gtRightSide,0);
  3879.           glEndList;
  3880.           glNewList(fGeneralLists+dlGridTop,GL_Compile);
  3881.             CreateGrid(aPt1,aPt2,gttop,0);
  3882.           glEndList;
  3883.           glNewList(fGeneralLists+dlGridBottom,GL_Compile);
  3884.             CreateGrid(aPt1,aPt2,gtBottom,0);
  3885.           glEndList;
  3886.           //glcallList(fGeneralLists+dlFullRenderMode);
  3887.       Finally
  3888.        RestoreState;
  3889.       end;
  3890.   Except
  3891.       On EInvalidOp do else Raise;
  3892.   end;
  3893. end;
  3894. (******* ******************************************************)
  3895. Procedure TCustomOpenGLWindow.CloseDisplayLists;
  3896. Begin
  3897.   glDeleteLists(fGeneralLists,glGeneralListSize);
  3898.   glDeleteLists(fDefaultFlatTextID,256);
  3899.   glDeleteLists(fDefaultTextID,256);
  3900. end;
  3901. (******************************************************)
  3902. Procedure SetAngleVal(MaxVal:Single;var CVal:Single);
  3903. Begin
  3904.   If CVal>=MaxVal then CVal:=CVal-MaxVal else
  3905.   If CVal<=-MaxVal then CVal:=maxVal+CVal;
  3906. end;
  3907. (******************************************************)
  3908. Procedure TCustomOpenGLWindow.ClearSelectList;
  3909. Begin
  3910.   fSelectPoints.Clear;
  3911.   fSelectstate:=stNone;
  3912.   Repaint;
  3913. end;
  3914. (******************************************************)
  3915. Procedure TCustomOpenGLWindow.ClearMoveList;
  3916. Begin
  3917.   fMovePoints.Clear;
  3918.   Repaint;
  3919. end;
  3920. (******************************************************)
  3921. Procedure TCustomOpenGLWindow.GetMeasurementData(var aMeasRec:tMeasureRecord);
  3922. Begin
  3923.   GetListData(aMeasRec,fMovePoints);
  3924. end;
  3925. (******************************************************)
  3926. Procedure TCustomOpenGLWindow.SnapToPoint(aX,aY,aZ:Double;aHint:String);
  3927.     // Move the cursor to this point and set the screenZ to the correct value
  3928. Var AP:TLinkPoint;
  3929.     TP:TPoint;
  3930. Begin
  3931.   EnableGL;
  3932.   AP:=tLinkPoint.CreateSpecial(aX,aY,aZ);
  3933.   ConvertWorldToScreen(ap);
  3934.   fViewer.ScreenZ:= aP.ScreenZ;
  3935.   TP:=ClientOrigin;
  3936.   SetCursorPos(TP.X+aP.SX,TP.Y+GetWindowPos(aP.SY));
  3937.   aP.Free;
  3938.   fSnapPoint.X:=aX;
  3939.   fSnapPoint.Y:=aY;
  3940.   fSnapPoint.Z:=aZ;
  3941.   fSnapOn:=True;
  3942.   UpdateScreenCoordsLabel;
  3943.   UpdateExtraScreenCoordsLabel;
  3944.   // check for GLErrors
  3945.   GetError;
  3946. end;
  3947. (******************************************************)
  3948. Procedure TCustomOpenGLWindow.ShowGLHint(Var aHintStr:String; Var CanShow:Boolean; Var HintInfo:tHintInfo);
  3949.     // call to handle any hint showing  stuff
  3950. Begin
  3951.   If (HintInfo.HintControl is TCustomOpenGLWindow) then
  3952.   With HintInfo do Begin
  3953.     ReShowTimeOut:=50;
  3954.     HideTimeOut  :=50;
  3955.   end;
  3956. end;
  3957. (******************************************************)
  3958. Procedure TCustomOpenGLWindow.getBirdsEyeView(aBP:tBitMap;aSize:LongInt);
  3959.     //return bitmap filled with bitmap centred on mouse pos and size
  3960.     Begin
  3961.     end;
  3962. (******************************************************)
  3963. Function TCustomOpenGLWindow.GetSizedBitMapImage(aBP:tBitMap):Boolean;
  3964.     //return a high resolution bitmap of current view
  3965.   var oldDC:HDC;
  3966.       oldRC:HGLRC;
  3967.       oldcanvas:tCanvas;
  3968.       TempGL:TAbstractOpenGLBitmap;
  3969.       oldGDI:Boolean;
  3970.    Begin
  3971.      Result:=False;
  3972.      iF Not Assigned(aBP) then exit;
  3973.      If (aBP.Width=0) or (aBP.Height=0) then exit;
  3974.  
  3975.      TEMPGL:= TAbstractOpenGLBitmap.CreateInit(aBP,fBackColor);
  3976.      If TempGl.GLSessionOK then
  3977.       Begin
  3978.            oldDC:=fRenderDC;
  3979.            fREnderDC:=TEMPGL.RenderDC;
  3980.            OldRC:=fHRC;
  3981.            fHRC:=TEMPGL.GLRC;
  3982.            oldCanvas:=fCanvas;
  3983.            fCanvas:=TEMPGL.GLCanvas;
  3984.            OldGDI:=fGDIGeneric;
  3985.            fGDIGeneric:=True;
  3986.  
  3987.            fOtherWidth:=aBP.Width;
  3988.            fOtherHeight :=aBP.Height; // bitmap size=0 when drawing to screen
  3989.            fDrawToOther:=True;
  3990.  
  3991.            SetUpViewPort;
  3992.            SetUpViewingFrustrum;
  3993.            SetUpViewingTransform;
  3994.            BuildDisplayLists;
  3995.            UpdateScreenPos;
  3996.  
  3997.            UpdateScreenDisplayLists;
  3998.            PaintWindow(fRenderDC);
  3999.  
  4000.            getBitMapImage(aBP);
  4001.           //tidy up
  4002.            fDrawToOther:=False;
  4003.            fOtherWidth:=0;
  4004.            fOtherHeight :=0; // bitmap size=0 when drawing to screen
  4005.  
  4006.            fRenderDC  :=oldDC;
  4007.            fHRC       :=oldRC;
  4008.            fCanvas    :=oldcanvas;
  4009.            fGDIGeneric:=OldGDI;
  4010.            TempGL.Free;
  4011.  
  4012.            SetUpViewPort;
  4013.            SetUpViewingFrustrum;
  4014.            SetUpViewingTransform;
  4015.  
  4016.            UpdateScreenPos;
  4017.            UpdateScreenDisplayLists;
  4018.            RePaint;
  4019.            Result:=True;
  4020.       end else
  4021.       MessageDlg('Unable to build a memory image.',mtInformation,[mbok],0);
  4022.    end;
  4023. (******************************************************)
  4024. Procedure TCustomOpenGLWindow.getFittedBitMapImage(aBP:tBitMap);
  4025.     //return a specially composed bitmap filled with current view
  4026.   var tempBM:tBitMap;
  4027.       aRect:TRect;
  4028.       Info:      PBitmapInfo;
  4029.       InfoSize:  DWord;
  4030.       Image:     Pointer;
  4031.       ImageSize: DWord;
  4032.  
  4033.   begin
  4034.      If not assigned(aBP) then exit;
  4035.      If not enableGL then exit;
  4036.      Screen.Cursor:=crHourglass;
  4037.      // creates a fitted bitmap
  4038.      TempBM:=tBitmap.Create;
  4039.      getBitMapImage(tempBM);
  4040.      //  stretch to fit the supplied bitmap
  4041.      With aRect do
  4042.       Begin
  4043.          Left:=0;Top:=0;
  4044.          Right:=aBP.Width;Bottom:=aBP.Height;
  4045.       end;
  4046.  
  4047.       with tempBM do
  4048.        begin
  4049.         GetDIBSizes(Handle,InfoSize,ImageSize);
  4050.         Getmem(Info,InfoSize);
  4051.         try
  4052.           GetMem(Image,ImageSize);
  4053.           try
  4054.             GetDIB(Handle,Palette,Info^,Image^);
  4055.             with Info^.bmiHeader do
  4056.               StretchDIBits(aBP.Canvas.handle,aRect.left,arect.top,aRect.right-arect.left,
  4057.                aRect.bottom-aRect.top,0,0,biWidth,biHeight,image,Info^,DIB_RGB_COLORS,
  4058.                SRCCOPY);
  4059.           finally
  4060.           FreeMem(Image,ImageSize);
  4061.           end;
  4062.         finally
  4063.           FreeMem(info,InfoSize);
  4064.         end;
  4065.        end;
  4066.      TempBM.Free;
  4067.   // check for GLErrors
  4068.      GetError;
  4069.      Screen.Cursor:=crDefault;
  4070.    {end;}
  4071.   end;
  4072. (******************************************************)
  4073. Function TCustomOpenGLWindow.getScaledMetaFileImage(PixSizeX,PixSizeY:Integer;  //Pixel size of window
  4074.                                 PixResX,PixResY:Single ;     //scale in Pixel/mm
  4075.                                 aPrintScale:Double):tMetaFile;//scale value -1=not to scale
  4076.     //draw the image to a Metafile.  Will fail if in perspective view.
  4077.     Type
  4078.     TempRec =Record
  4079.         X,Y :Integer;
  4080.         end;
  4081.     Var h,w:GLfloat;
  4082.         Dist:Double;
  4083.         aMF:tMetaFile;
  4084.         MaxVal:TempRec;
  4085.         PixScaleX,PixScaleY,TempScale:Double;
  4086.         TempX,TempY: Integer;
  4087.  
  4088.    Begin
  4089.      Result:=nil;
  4090.      If (PixSizeX=0) or (PixSizeY=0) then exit;
  4091.      If (PixResX=0)  or (PixResY=0)  then exit;
  4092.      If Perspective and (aPrintScale>0) then exit;
  4093.   //cant do scale in perspective view
  4094.  
  4095.      aMF:=tMetaFile.Create;
  4096.  
  4097.      If aPrintscale<=0 then
  4098.         TempScale:=1000 else
  4099.         TempScale:=aPrintScale;;
  4100.     Try
  4101.      EnableGL;
  4102.      aMF.Width :=PixSizeX;
  4103.      aMF.Height:=PixSizeY;
  4104.  
  4105.      PixScaleX:=1;
  4106.      PixScaleY:=1;
  4107.      TempX:=PixSizeX;
  4108.      TempY:=PixSizeY;
  4109.  
  4110.      glGetIntegerv(GL_MAX_VIEWPORT_DIMS,@MaxVal);
  4111.    // If the requested size is larger tahn the GL session can support
  4112.    // then the size must re rescaled to suit.
  4113.      If (PixSizeX>MaxVal.X) or (PixSizeY>MaxVal.Y) then
  4114.        Begin
  4115.          //set up the pixscale values and the best viewport size.
  4116.          If PixSizeX=PixSizeY then
  4117.           Begin
  4118.    // same siz in X and Y
  4119.            PixScaleY:=(maxVal.X/PixSizeX)*(PixResX/PixResY);
  4120.            PixScaleX:=(MaxVal.Y/PixSizeY)*(PixResY/PixResX);
  4121.            TempX:=Round(PixSizeX*PixScaleX);
  4122.            TempY:=Round(PixSizeY*PixScaleY);
  4123.           end else
  4124.              If PixSizeX>PixSizeY then
  4125.                Begin
  4126.                  PixScaleY:=(maxVal.X/PixSizeX)*(PixResX/PixResY);
  4127.                  TempX:=PixSizeX;
  4128.                  TempY:=Round(PixSizeY*PixScaleY);
  4129.                end else
  4130.                Begin
  4131.                  PixScaleY:=(MaxVal.Y/PixSizeY)*(PixResY/PixResX);
  4132.                  TempY:=PixSizeY;
  4133.                  TempX:=Round(PixSizeX*PixScaleY);
  4134.                end;
  4135.        end;
  4136.  
  4137.      // viewport matrix setup with the new "window" size
  4138.          glViewport(0,0,TempX,TempY);
  4139.          glGetIntegerv(GL_VIEWPORT,pGLInt(@fViewPort));
  4140.  
  4141.         // setup the Projection for the scale case else leave alone
  4142.          glMatrixMode(GL_PROJECTION);
  4143.          glLoadIdentity;
  4144.        // this may need some work
  4145.          h:=(PixSizeX/PixResX) *(TempScale/1000);
  4146.          w:=(PixSizeY/PixResY) *(TempScale/1000);
  4147.  
  4148.          with fViewer do
  4149.            begin
  4150.               Dist:=Distance*5;
  4151.        //manage the perspective case or the Ortho case
  4152.               glOrtho(-w/2,w/2,-h/2,h/2,1,Dist);
  4153.               fGLperPixel:=w/tempX;
  4154.       //check this value
  4155.               glGetDoublev(GL_PROJECTION_MATRIX,pGLDouble(@fprojMatrix));
  4156.      // projection matrix
  4157.               glMatrixMode(GL_MODELVIEW);
  4158.            end; //end setup modelview
  4159.       // check for GLErrors
  4160.            GetError;
  4161.      // need to sset up the temporaru draw to Other flag
  4162.  
  4163.            fDrawToOther:=True;
  4164.            fOtherWidth :=TempX;
  4165.            fOtherHeight:=TempY;
  4166.  
  4167.            If GetMetaFileImage(aMF,1,1/PixScaleX,1/PixScaleY)  then
  4168.               Result :=aMF else
  4169.               aMF.Free;
  4170.  
  4171.       Finally
  4172.    //reset the GL session;
  4173.        fDrawToOther:=False;
  4174.        fOtherWidth:=0;
  4175.        fOtherHeight:=0;
  4176.        SetUpViewPort;
  4177.        SetUpViewingFrustrum;
  4178.        SetUpViewingTransform;
  4179.       end;
  4180.     end;
  4181. (******************************************************)
  4182. Function TCustomOpenGLWindow.getMetaFileImage(aMF:tMetaFile;UseMFHeight:Integer;XScale,YScale:Double):Boolean;
  4183.   //O= use window height 1=use mf.height 2= use mf.mmheight
  4184.   var
  4185.      TempMFC   : tMetaFileCanvas;
  4186.      Buffer    : Pointer;
  4187.      fFeedBackData ,Step         : Integer;
  4188.      GotAllTheData   : Boolean;
  4189.      BufSize:Longint;
  4190.      tHt : Integer;
  4191.      oldCanvas:TCanvas;
  4192.   Begin
  4193.      Result:=False;
  4194.       If not assigned(aMF) then exit;
  4195.       Case  UseMFHeight of
  4196.         0:tHt:=Height;
  4197.         1:tHt:=aMF.Height;
  4198.         2:tHt:=aMF.mmHeight;
  4199.         else tHt:=Height;
  4200.        end;
  4201.       TempMFC:=TMetaFileCanvas.CreateWithComment(aMF,0,'OpenGL App','GL Scene');
  4202.     //create a metafile canvas
  4203.       GotAllTheData:=False;
  4204.       Step:=1;
  4205.       oldCanvas:=fCanvas;
  4206.       fCanvas:=TempMFC;
  4207.   // swap in a temporary canvas
  4208.       GetViewPortGrid(glGridType(fViewmode),20);
  4209.     // setup the grid data
  4210.  
  4211.       BufSize:=fbBufferSizetiny;
  4212.       Repeat
  4213.             If Step>1 then BufSize:=BufSize*2;
  4214.             GetMem(Buffer,BufSize*SizeOf(Single));
  4215.             glFeedbackBuffer(BufSize,GL_3D_COLOR,Buffer);
  4216.        // set the render to the feedback buffer
  4217.             glRenderMode(GL_FEEDBACK);
  4218.             fRebuildNeeded:=True;
  4219.        // render the window
  4220.             GLRenderWindow(False);
  4221.             fFeedBackData:=glRenderMode(GL_RENDER);
  4222.             If (fFeedBackData>=0) then
  4223.               Begin
  4224.                 GotAllTheData:=True;
  4225.                 DrawFeedBackDataToCanvas(TempMFC,
  4226.                                          fFeedbackdata,
  4227.                                          pFeedBackArray(Buffer),
  4228.                                          GL_3D_COLOR,
  4229.                                          tHt,
  4230.                                          nil,
  4231.                                          XScale,YScale);
  4232.               end;
  4233.             FreeMem(Buffer,BufSize*SizeOf(Single));
  4234.             Inc(step);
  4235.       until GotAllTheData or (Step=4);
  4236.       Result:=GotAllTheData;
  4237.       TempMFC.Free;
  4238.       fCanvas:=oldCanvas;
  4239.    end;
  4240. (******************************************************)
  4241.  Procedure TCustomOpenGLWindow.CopyToClipBoard;
  4242.     //copy the current view to the clipboard as a bitmap and a metafile
  4243.  const
  4244.   HiMetricPerInch : Longint = 2540;
  4245.  
  4246.  var tempBM    : tBitMap;
  4247.      TempMF    : tMetaFile;
  4248.  
  4249.      aFormat : word;
  4250.      aData   : tHandle;
  4251.      aPalette : hPalette;
  4252.    Begin
  4253.      TempBM:=tBitmap.Create;
  4254.      TempMF:=TMetaFile.Create;
  4255.      TempMF.Width:=Width;
  4256.      TempMF.Height:=Height;
  4257.  
  4258.     Try
  4259.      getBitMapImage(tempBM);
  4260.      tempbm.SaveToClipboardFormat(aFormat,aData,apalette);
  4261.      With ClipBoard do
  4262.        Begin
  4263.        Open;
  4264.        SetAsHandle(aFormat,AData);
  4265.        if aPalette <> 0 then SetClipboardData(CF_PALETTE, aPalette);
  4266.        end;
  4267.  
  4268.     getMetaFileImage(TempMF,0,1,1);
  4269.     TempMF.SaveToClipboardFormat(aFormat,aData,apalette);
  4270.     With ClipBoard do
  4271.       Begin
  4272.       SetAsHandle(aFormat,AData);
  4273.       if aPalette <> 0 then SetClipboardData(CF_PALETTE, aPalette);
  4274.       end;
  4275.     finally
  4276.       ClipBoard.Close;
  4277.       tempBM.Free;
  4278.       TempMF.Free;
  4279.     end;
  4280.   end;
  4281.  
  4282. (******************************************************)
  4283. Procedure TCustomOpenGLWindow.getBitMapImage(aBP:tBitMap);
  4284.   var
  4285.   BitsMem     : pointer;
  4286.   BmInfo      : tBitmapInfo;
  4287.   bitsize,
  4288.   WinWidth,
  4289.   WinHeight,
  4290.   scanWidth,
  4291.   T1,T2       : DWord;
  4292.   aRGB        : pGLRGB;
  4293.   temp        : GLUByte;
  4294.   tDC         : HDC;
  4295.   TempBitMap  : HBitMap;
  4296.   aMem        : TMemoryStream;
  4297.   Info        : TBitmapFileHeader;
  4298.   InfoSize    : DWord;
  4299.   InfoHeader  : TBitMapInfoHeader;
  4300.  
  4301.         Procedure  SwapTheRGBValues;
  4302.         Var iVal,jVal:DWord;
  4303.         Begin
  4304.       //swap the bytes as the RGB values are in the reverse order
  4305.          T1:=LongInt( Bitsmem);
  4306.          For ival:=0 to WinHeight-1 do
  4307.           Begin
  4308.            T2:=T1+(ival*ScanWidth);
  4309.            aRGB:=pGLRGB(ptr(T2));
  4310.            For jval:=0 to WinWidth-1 do
  4311.             Begin
  4312.               If aRGB^[1]<>aRGB^[3] then   //only swap if the values are different
  4313.                  Begin
  4314.                   Temp:=aRGB^[1];
  4315.                   aRGB^[1]:=aRGB^[3];
  4316.                   aRGB^[3]:=Temp;
  4317.                  end;
  4318.               t2:=t2+3;  // move to the next set
  4319.               aRGB:=pGLRGB(ptr(T2));
  4320.             end;
  4321.           end;
  4322.          end;
  4323.  
  4324.   Begin
  4325.     //quit if not valid to build
  4326.      If not assigned(aBP) then exit;
  4327.      If (fRenderDC=0) or (fHRC=0) then exit;
  4328.    // ensure the GL session is enabled
  4329.      If not enableGL then exit;
  4330.    //set up the BMF info and data structures
  4331.      FillChar(BmInfo,SizeOf(BmInfo),0);
  4332.  
  4333.      WinWidth:=  fviewport[3];//width of current GL screen
  4334.      WinHeight:= fviewport[4];//height of the current GL screen
  4335.      ScanWidth:=(WinWidth)*3; // scan width for the bitmap
  4336.      //need to fix alignment to 4 byte
  4337.      ScanWidth:=(ScanWidth+3) and $FFFFFFFC;
  4338.      BitSize:=ScanWidth*(WinHeight); //calculate the memory size needed for the bitmap
  4339.  
  4340.   // flush the GDI pipeline
  4341.      glFinish;
  4342.   // set up the gl  read
  4343.      If not fDrawToOther then
  4344.       glReadBuffer(GL_Back) else
  4345.       glReadBuffer(GL_Front);
  4346.      glPixelStorei(GL_PACK_ALIGNMENT,4);
  4347.      glPixelStorei(GL_PACK_ROW_LENGTH,0);
  4348.      glPixelStorei(GL_PACK_SKIP_ROWS,0);
  4349.      glPixelStorei(GL_PACK_SKIP_PIXELS,0);
  4350.      Try
  4351.   // read the glpixels from the video buffer
  4352.      GetMem(Bitsmem,bitsize); // Allocate memory to read pixels into
  4353.      Except
  4354.       on EOutOfMemory do Bitsmem:=nil
  4355.       else Raise;
  4356.      end;
  4357.      If BitsMem<>Nil then
  4358.      Begin
  4359.      // get th bits data
  4360.          glReadPixels(0,         //X
  4361.                       0,         //Y
  4362.                       WinWidth,  //Width
  4363.                       WinHeight, //Height
  4364.                       GL_RGB,    //Format of data read
  4365.                       GL_UNSIGNED_BYTE, //Type of data
  4366.                       Bitsmem);  // pointer to memory storage
  4367.          SwapTheRGBValues;
  4368.       // reverse the order of the RGB values
  4369.          TDC:=CreateDC('Display',nil,nil,nil);
  4370.       // attempt to create a DIB bitmap handle
  4371.          If TDC<>0 then
  4372.            Begin
  4373.              With BmInfo.bmiheader do
  4374.                Begin
  4375.                  biSize:=SizeOf(TBitMapInfoHeader);
  4376.                  biWidth:=WinWidth;      //width of the bitmap
  4377.                  biHeight:=WinHeight;    //height of the bitmap
  4378.                  biPlanes:=1;            //always 1
  4379.                  biBitCount:=24;         //24 bit colour for bitmap
  4380.                  biCompression:=BI_RGB;  //No compression
  4381.                  biSizeImage:=BitSize;   //size of the image
  4382.                  biXPelsPermeter:=2952;  //75dpi
  4383.                  biYPelsPermeter:=2952;  //75dpi
  4384.                  biClrUsed:=0;
  4385.                  biClrImportant:=0;
  4386.                end;
  4387.              //set up the Bitmap info header
  4388.               TempBitMap:= CreateDIBitmap(tDC,BmInfo.bmiheader,
  4389.                                           cbm_Init,Bitsmem,bmInfo,DIB_RGB_COLORS)
  4390.            end else TempBitMap:=0;
  4391.         try
  4392.          If tempBitMap<>0 then
  4393.           Begin
  4394.              SelectObject(TDC,TempBitMap); //select the bitmap into the DC
  4395.              aBP.Handle:=TempBitMap;       //assign the bitmap to the tBitmap handle
  4396.           end else
  4397.         //fail on the BID create handle then manually build the bitmap
  4398.           Begin
  4399.             FillChar(Info,SizeOf(Info),0);
  4400.             FillChar(InfoHeader,SizeOf(InfoHeader),0);
  4401.             With Info do
  4402.              Begin
  4403.                bfType:=$4D42;
  4404.                InFoSize:=SizeOf(InfoHeader);
  4405.                bfSize:=sizeOf(info)+ InfoSize+ bitsize;
  4406.                bfOffBits:=sizeOf(info)+ Infosize;
  4407.              end;
  4408.             With InfoHeader do
  4409.              Begin
  4410.                biSize:=SizeOf(InfoHeader);
  4411.                biWidth:=WinWidth;
  4412.                biHeight:=WinHeight;
  4413.                biPlanes:=1;
  4414.                biBitCount:=24;
  4415.                biCompression:=BI_RGB;
  4416.                biSizeImage:=BitSize;
  4417.                biXPelsPermeter:=2952;//75dpi
  4418.                biYPelsPermeter:=2952;//75dpi
  4419.                biClrUsed:=0;
  4420.                biClrImportant:=0;
  4421.              end;
  4422.             aMem:=tMemoryStream.Create;// create a temporary memory stream
  4423.             aMem.Write(Info,SizeOf(info)); // write the info block
  4424.             aMem.Write(InfoHeader,SizeOf(InfoHeader));//write the information header block
  4425.             aMem.Write(BitsMem^,BitSize); //write the pixels data
  4426.             aMem.Position:=0;  //reset the stream
  4427.             aBP.LoadFromStream(aMem); //  load theimage into the tBitMap
  4428.             aMem.Free;  //tidy up
  4429.           end;
  4430.         Finally
  4431.       //tidy up
  4432.          If TDC<>0 then DeleteDC(TDC);
  4433.          FreeMem(Bitsmem,bitsize);
  4434.         end;
  4435.     end;
  4436.   // check for GLErrors
  4437.      GetError;
  4438.   end;
  4439. (******************************************************)
  4440. Procedure TCustomOpenGLWindow.SetXCubeSize(aVal:Double);
  4441. Begin
  4442.   If (fViewer.XRadius=aVal)then exit;
  4443.   fViewer.XRadius:=aVal;
  4444.   if fHRC=0 then  exit;
  4445.   ReSetView(false);
  4446.   Repaint;
  4447. end;
  4448. (******************************************************)
  4449. Procedure TCustomOpenGLWindow.SetYCubeSize(aVal:Double);
  4450. Begin
  4451.   If (fViewer.YRadius=aVal)then exit;
  4452.   fViewer.YRadius:=aVal;
  4453.   if fHRC=0 then  exit;
  4454.   ReSetView(false);
  4455.   Repaint;
  4456. end;
  4457. (******************************************************)
  4458. Procedure TCustomOpenGLWindow.SetZCubeSize(aVal:Double);
  4459. Begin
  4460.   If (fViewer.ZRadius=aVal)then exit;
  4461.   fViewer.ZRadius:=aVal;
  4462.   if fHRC=0 then  exit;
  4463.   ReSetView(false);
  4464.   Repaint;
  4465. end;
  4466. (******************************************************)
  4467. function TCustomOpenGLWindow.GetPerspective: Boolean;
  4468. Begin
  4469.   Result:= fViewer.Perspective;
  4470. end;
  4471. (******************************************************)
  4472. Procedure TCustomOpenGLWindow.SetPerspective(AState:Boolean);
  4473. Var TempZ:Double;
  4474.     aScrnPt:TPoint;
  4475.  
  4476. Begin
  4477.   If fViewer.Perspective=aState then exit;
  4478.   fViewer.Perspective:=AState;
  4479.   if fHRC=0 then  exit;
  4480.   SetUpViewPort;
  4481.   SetUpViewingFrustrum;
  4482.   SetUpViewingTransform;
  4483.  //Set screenZ value by projecting fHome onto the screen
  4484.   If not ProjectOnScreen(fHome,aScrnPt,TempZ) then
  4485.     TempZ:=0.5;
  4486.   viewer.screenZ:=TempZ;
  4487.   Repaint;
  4488. end;
  4489. (******************************************************)
  4490. Procedure TCustomOpenGLWindow.SetSimpleAxis(AState:Boolean);
  4491. Begin
  4492.   If fSimpleAxis=aState then exit;
  4493.   fSimpleAxis:=AState;
  4494.   if fHRC=0 then  exit;
  4495.   SetUpViewingFrustrum;
  4496.   Repaint;
  4497. end;
  4498. (******************************************************)
  4499. Procedure TCustomOpenGLWindow.SetRenderMode(aRM:GLRenderState);
  4500. Begin
  4501.   If aRM=fRenderMode then exit;
  4502.   fRenderMode:=aRM;
  4503.   if fHRC=0 then  exit;
  4504.   //GLRenderState  =(rmFull,rmQuick,rmMotion,rmThread,rmAnimation,rmViewAnimate,fmGDIOnly);
  4505.   Case fRenderMode of
  4506.     rmFull:   CallList(fGeneralLists+dlFullRenderMode) ;
  4507.     rmQuick:  CallList(fGeneralLists+dlQuickRenderMode) ;
  4508.   else CallList(fGeneralLists+dlFullRenderMode);
  4509.   end;
  4510.   Repaint;
  4511. end;
  4512. (******************************************************)
  4513. Procedure TCustomOpenGLWindow.SetBackColor(aColor:GLBackground);
  4514. Begin
  4515.   fBackColor:=aColor;
  4516.   Case fBackColor   of
  4517.     glWhiteBkgd:
  4518.       Begin
  4519.         glBlack[1]:=0;
  4520.         glBlack[2]:=0;
  4521.         glBlack[3]:=0;
  4522.         glBlack[4]:=1;
  4523.       end;
  4524.     glBlackBkgd:
  4525.       Begin
  4526.         glBlack[1]:=1;
  4527.         glBlack[2]:=1;
  4528.         glBlack[3]:=1;
  4529.         glBlack[4]:=1;
  4530.       end;
  4531.   end;
  4532.   If fHRC=0 then exit;
  4533.   GLLock;
  4534.   EnableGL;
  4535.   If fBackColor=glWhiteBkgd then
  4536.     glClearColor(1.0,1.0,1.0,1.0)
  4537.   else
  4538.     glClearColor(0.0,0.0,0.0,1.0);
  4539.   BuildDisplayLists;
  4540.   Repaint;
  4541.   // check for GLErrors
  4542.   GetError;
  4543.  
  4544. end;
  4545. (******************************************************)
  4546. Procedure TCustomOpenGLWindow.SetToolMode(aMode:GLToolMode);
  4547. Begin
  4548.   If (aMode=ftoolmode)or(fMoveMode<>mmNone) then exit;
  4549.   fToolMode:=aMode;
  4550.   fSelectstate:=stNone;
  4551.   {If fToolMode:=tlNone then }ClearSelectList;
  4552.   If fHRC=0 then exit;
  4553.   Repaint;
  4554. end;
  4555. (******************************************************)
  4556. Procedure TCustomOpenGLWindow.SetRefPoint(val:tGLPoint);
  4557.     // Set up the home point
  4558.   Begin
  4559.     If (fHome.X=Val.X) and (fHome.Y=Val.Y) and (fHome.Z=val.Z) then exit;
  4560.     fHome:=Val;
  4561.     ResetView(True);
  4562.     Repaint;
  4563.   end;
  4564. (******************************************************)
  4565. Procedure TCustomOpenGLWindow.SetMoveMode(aMode:GLMoveMode);
  4566. Begin
  4567.   If aMode=fMoveMode then exit;// do nothing
  4568.   // handle turning off the toolmode
  4569.   If (aMode<>mmNone) then
  4570.    Begin
  4571.     fLastToolMode:=fToolMode;
  4572.     fToolMode:=tlNone;
  4573.    end
  4574.   else
  4575.     fToolMode:=fLastToolMode;
  4576.    // change the move mode
  4577.   fMoveMode:=aMode;
  4578.   If ((fMoveMode=mmZoom)or
  4579.       (fMoveMode=mmSlide))and
  4580.      Perspective then Perspective:=False;
  4581.   ClearMoveList;   
  4582.   If fHRC=0 then exit;
  4583.   Repaint;
  4584. end;
  4585. (******************************************************)
  4586. Procedure TCustomOpenGLWindow.SetViewMode(aMode:GLViewMode);
  4587. Begin
  4588.   If aMode=fViewMode then exit;
  4589.   fViewMode:=aMode;
  4590.   If fHRC=0 then exit;
  4591.   ReSetView(False);
  4592.   Repaint;
  4593. end;
  4594. (******************************************************)
  4595. Procedure TCustomOpenGLWindow.SetScale(aVal:Single);
  4596. Begin
  4597.   If aVal=fViewer.Scale then exit;
  4598.   fViewer.Scale:=aval;
  4599.   If fHRC=0 then exit;
  4600.   ReSetView(False);
  4601.   Repaint;
  4602. end;
  4603. (******************************************************)
  4604. Procedure TCustomOpenGLWindow.SetHUD(Val:Boolean );
  4605. Begin
  4606.   If fHUDon=val then exit;
  4607.   fHUDon:=val;
  4608.   If fHRC=0 then exit;
  4609.   Repaint;
  4610. end;
  4611. (******************************************************)
  4612. (******* ******************************************************)
  4613. constructor TOpenGLCanvas.Create(AOwner: TComponent);
  4614. Begin
  4615.   Inherited Create;
  4616.   fColor:=glBlack;
  4617.   fLineWidth:=1;
  4618.   f3DMode:=True;
  4619.   fPointSize:=2;
  4620.   If (aOwner is TCustomOpenGLWindow) then fGLWin:=TCustomOpenGLWindow(aOwner);
  4621. end;
  4622. (******* ******************************************************)
  4623. destructor TOpenGLCanvas.Destroy;
  4624. Begin
  4625.   Inherited Destroy;
  4626. end;
  4627. (******* ******************************************************)
  4628. Procedure TOpenGLCanvas.SetLineWidth(aWidth:glFloat);
  4629. Var MaxMinWidth:Array[1..2]of glFloat;
  4630. Begin
  4631.   If aWidth=fLinewidth then exit;
  4632.   glGetFloatv(GL_Line_Width_Range,@MaxMinWidth);
  4633.   If (aWidth>MaxMinWidth[2]) then fLineWidth:=MaxMinWidth[2] else
  4634.   If (aWidth<MaxMinWidth[1]) then fLineWidth:=MaxMinWidth[1] else
  4635.   fLineWidth:=aWidth;
  4636.   glLineWidth(fLineWidth);
  4637. end;
  4638. (******* ******************************************************)
  4639. Procedure TOpenGLCanvas.SetLineStyle(aStyle:gluShort);
  4640.  Begin
  4641.    If aStyle=fStipple then exit;
  4642.    fStipple:=aStyle;
  4643.    If fStipple<>stContinous then
  4644.    Begin
  4645.        glEnable (GL_LINE_Stipple);
  4646.        glLineStipple(1, fStipple);
  4647.    end else
  4648.        glDisable(GL_LINE_STIPPLE);
  4649.  end;
  4650. (******* ******************************************************)
  4651. Procedure TOpenGLCanvas.MoveTo(aPt:tGLPoint);
  4652. Begin
  4653.   fCurrentPoint.X:=aPt.X;
  4654.   fCurrentPoint.Y:=aPt.Y;
  4655.   fCurrentPoint.Z:=aPt.Z;
  4656.   {set RastorPos for possible test drawing}
  4657.   glRasterPos3dv(@aPt);
  4658. end;
  4659. (******* ******************************************************)
  4660. Procedure TOpenGLCanvas.DrawPoint(aPt:tGLPoint);
  4661. Begin
  4662.   glColor4fv(@fColor);
  4663.   glPointSize(fPointSize);
  4664.   glPushmatrix;
  4665.   Case fPointMode of
  4666.     ptSimple:
  4667.       Begin
  4668.         glBegin(GL_Points);
  4669.           If f3DMode Then glVertex3dv(@aPt) else glVertex2dv(@aPt);
  4670.         glEnd;
  4671.       end;
  4672.     ptCross:
  4673.       Begin
  4674.         glTranslated(aPt.X,aPt.Y,aPt.Z);
  4675.         If fPointSize>0 then glScalef(fPointSize,fPointSize,fPointsize);
  4676.         fGLWin.Calllist(fGLWin.DisplayList+dlPointCross);
  4677.       end;
  4678.     ptShpere:
  4679.       Begin
  4680.         glTranslated(aPt.X,aPt.Y,aPt.Z);
  4681.         If fPointSize>0 then glScalef(fPointSize,fPointSize,fPointsize);
  4682.         fGLWin.Calllist(fGLWin.DisplayList+dlPointSphere);
  4683.       end;
  4684.     ptCube:;
  4685.   end; {case}
  4686.   glPopMatrix;
  4687.   MoveTo(aPt);
  4688. end;
  4689. (******* ******************************************************)
  4690. Procedure TOpenGLCanvas.LineTo(aPt:tGLPoint);
  4691. Begin
  4692.   glLineWidth(fLineWidth);
  4693. //set the line width (stored by the GLCanvas)
  4694.   glColor4fv(@fColor);
  4695. //set the line colour  (stored by the GLCanvas)
  4696.   glPassThrough(1000+fLinewidth);
  4697. //use the glPassthrough to signal a line width when creating a metafile
  4698.   glBegin(GL_Lines);
  4699. //call the OpenGL Start line
  4700.   If f3DMode then
  4701.     Begin
  4702.       glVertex3dv(@fCurrentPoint);
  4703. //uses the current point as the start point of the line (stored by the GLCanvas)
  4704.       glVertex3dv(@aPt);
  4705. //pass pointers to the 3D points data
  4706. //passing pointers to data is faster than passing the data!!!!
  4707.     end else
  4708.     Begin
  4709.       glVertex2dv(@fCurrentPoint);
  4710.       glVertex2dv(@aPt);
  4711.  // pass through pointers signalling 2D data
  4712.     end;
  4713.   glEnd;
  4714. // close the OpenGL begin
  4715.   MoveTo(aPt);
  4716. // set the glCanvas current point to the end point of the line
  4717. end;
  4718. (******* ******************************************************)
  4719. Procedure TOpenGLCanvas.DrawLine(aStart,aEnd:tGLPoint);
  4720. Begin
  4721.   glLineWidth(fLineWidth);
  4722.   glBegin(GL_Lines);
  4723.     glColor3fv(@fColor);
  4724.     glVertex3dv(@aStart);
  4725.     glVertex3dv(@aEnd);
  4726.   glEnd;
  4727.   MoveTo(aEnd);
  4728. end;
  4729. (*************************************************************)
  4730. Procedure TOpenGLCanvas.DrawTriangle(P1,P2,P3:tGLPoint;C1,C2,C3:glColorVal);
  4731. Begin
  4732.   glBegin(GL_TRIANGLES);
  4733.     glColor3fv(@C1);
  4734.     glVertex3dv(@P1);
  4735.     glColor3fv(@C2);
  4736.     glVertex3dv(@P2);
  4737.     glColor3fv(@C3);
  4738.     glVertex3dv(@P3);
  4739.   glEnd;
  4740. end;
  4741. (*************************************************************)
  4742.  Procedure TOpenGLCanvas.DrawQuad(P1,P2,P3,P4:tGLPoint;C1,C2,C3,C4:glColorVal);
  4743.   Begin
  4744.   glBegin(GL_QUADS);
  4745.     glColor3fv(@C1);
  4746.     glVertex3dv(@P1);
  4747.     glColor3fv(@C2);
  4748.     glVertex3dv(@P2);
  4749.     glColor3fv(@C3);
  4750.     glVertex3dv(@P3);
  4751.     glColor3fv(@C4);
  4752.     glVertex3dv(@P4);
  4753.   glEnd;
  4754.  end;
  4755. (*************************************************************)
  4756.  Procedure TOpenGLCanvas.DrawRectangle(P1,P2:tGLPoint);
  4757.   Begin
  4758.      glLineWidth(fLineWidth);
  4759.      glColor4fv(@fColor);
  4760.      glRectdv(@P1,@P2);
  4761.   end;
  4762. (*************************************************************)
  4763. Procedure TOpenGLCanvas.TextOut2D(loc:tGLPoint;aSize:glFloat;aStr:String);
  4764. Begin
  4765.   If length(aStr)>255 then exit;
  4766.   If not fGLWin.StdDisplayList then exit;
  4767.   glListBase(fGLWin.fDefaultFlatTextID);
  4768.   glPushMatrix;
  4769.   glScalef(aSize,aSize,aSize);
  4770.   glRasterPos3dv(@loc);
  4771.   glCallLists(length(aSTR),GL_Unsigned_Byte,@aStr[1]);
  4772.   glPopMatrix;
  4773.   glListBase(0);
  4774. end;
  4775. (*************************************************************)
  4776. Procedure TOpenGLCanvas.TextOut3D(loc:tGLPoint;aSize:glFloat;aStr:String);
  4777. Begin
  4778.   If (aSize=0) then exit;
  4779.   If not fGLWin.StdDisplayList then exit;
  4780.   If length(aStr)>255 then exit;
  4781.   glListBase(fGLWin.fDefaultTextID);
  4782.   glPushMatrix;
  4783.   glTranslatef(loc.X,loc.Y,loc.Z);
  4784.   glScalef(aSize,aSize,aSize);
  4785.   glCallLists(length(aSTR),GL_Unsigned_Byte,@aStr[1]);
  4786.   glPopMatrix;
  4787.   glListBase(0);
  4788. end;
  4789. (*************************************************************)
  4790. Procedure TOpenGLCanvas.DrawAxis(loc:tGLPoint;aSize:glFloat;aMode:GLRenderState);
  4791.     Begin
  4792.       If (aSize=0) then exit;
  4793.       If not fGLWin.StdDisplayList then exit;
  4794.       glPushMatrix;
  4795.       glTranslated(loc.X,loc.Y,loc.Z);
  4796.       glScalef(aSize,aSize,aSize);
  4797.       If aMode= rmFull then
  4798.         fGLWin.CallList(fGLWin.DisplayList+dlFullAxis)
  4799.       else
  4800.         fGLWin.CallList(fGLWin.DisplayList+dlQuickAxis);
  4801.       glPopMatrix;
  4802.     end;
  4803. (*************************************************************)
  4804.   Procedure TOpenGLCanvas.CircleXY(loc:tGLPoint;XRadius,YRadius:glFloat);
  4805.     Begin
  4806.       If (XRadius=0) or (YRadius=0) then exit;
  4807.       If not fGLWin.StdDisplayList then exit;
  4808.       glPushMatrix;
  4809.       glTranslated(loc.X,loc.Y,loc.Z);
  4810.       glScalef(XRadius,yRadius,1);
  4811.       glLineWidth(fLineWidth);
  4812.       glColor4fv(@fColor);
  4813.       fGLWin.CallList(fGLWin.DisplayList+dlXYCircle);
  4814.       glPopMatrix;
  4815.       MoveTo(loc);
  4816.     end;
  4817.  
  4818. (*************************************************************)
  4819.   Procedure TOpenGLCanvas.CircleXZ(loc:tGLPoint;XRadius,ZRadius:glFloat);
  4820.     Begin
  4821.       If (XRadius=0) or (ZRadius=0) then exit;
  4822.       If not fGLWin.StdDisplayList then exit;
  4823.       glPushMatrix;
  4824.       glTranslated(loc.X,loc.Y,loc.Z);
  4825.       glScalef(XRadius,1,ZRadius);
  4826.       glLineWidth(fLineWidth);
  4827.       glColor4fv(@fColor);
  4828.       fGLWin.CallList(fGLWin.DisplayList+dlXZCircle);
  4829.       glPopMatrix;
  4830.       MoveTo(loc);
  4831.     end;
  4832. (*************************************************************)
  4833.  Procedure TOpenGLCanvas.DrawSelectHandle(aSize:Double);
  4834.     // Selection handle at present position
  4835.   Begin
  4836.       glPushMatrix;
  4837.       If not fGLWin.StdDisplayList then exit;
  4838.       glTranslated(fCurrentPoint.X,fCurrentPoint.Y,fCurrentPoint.Z);
  4839.       glScalef(aSize,aSize,aSize);
  4840.       fGLWin.CallList(fGLWin.DisplayList+dlSelectCube);
  4841.       glPopMatrix;
  4842.   end;
  4843. (*************************************************************)
  4844.  Procedure TOpenGLCanvas.DrawLockedSelectHandle(aSize:Double);
  4845.     // draw locked selection handle
  4846.   Begin
  4847.       glPushMatrix;
  4848.       If not fGLWin.StdDisplayList then exit;
  4849.       glTranslated(fCurrentPoint.X,fCurrentPoint.Y,fCurrentPoint.Z);
  4850.       glScalef(aSize,aSize,aSize);
  4851.       fGLWin.CallList(fGLWin.DisplayList+dlLockedSelectCube);
  4852.       glPopMatrix;
  4853.   end;
  4854. (*************************************************************)
  4855.   Procedure TOpenGLCanvas.CircleYZ(loc:tGLPoint;YRadius,ZRadius:glFloat);
  4856.     Begin
  4857.       If (YRadius=0) or (ZRadius=0) then exit;
  4858.       If not fGLWin.StdDisplayList then exit;
  4859.       glPushMatrix;
  4860.       glTranslated(loc.X,loc.Y,loc.Z);
  4861.       glScalef(1,YRadius,ZRadius);
  4862.       glLineWidth(fLineWidth);
  4863.       glColor4fv(@fColor);
  4864.       fGLWin.CallList(fGLWin.DisplayList+dlYZCircle);
  4865.       glPopMatrix;
  4866.       MoveTo(loc);
  4867.     end;
  4868. (*************************************************************)
  4869. (*************************************************************)
  4870. { TCustomOpenGLWindowActionLink }
  4871.  
  4872. procedure TCustomOpenGLWindowActionLink.AssignClient(AClient: TObject);
  4873. begin
  4874.   inherited AssignClient(AClient);
  4875.   FClient := AClient as TCustomOpenGLWindow;
  4876. end;
  4877.  
  4878. function TCustomOpenGLWindowActionLink.IsHelpContextLinked: Boolean;
  4879. begin
  4880.   Result := inherited IsHelpContextLinked and
  4881.     (FClient.HelpContext = (Action as TCustomAction).HelpContext);
  4882. end;
  4883.  
  4884. procedure TCustomOpenGLWindowActionLink.SetHelpContext(Value: THelpContext);
  4885. begin
  4886.   if IsHelpContextLinked then FClient.HelpContext := Value
  4887. end;
  4888. (******* ******************************************************)
  4889. (******* ******************************************************)
  4890. (*
  4891. procedure Register;
  4892. begin
  4893.   RegisterComponents('OpenGL', [TCustomOpenGLWindow]);
  4894. end;
  4895.  *)
  4896. end.
  4897.